home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173c_bas.zip / SOURCE / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1991-09-01  |  117KB  |  3,445 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS 17.3C, Copyright 1986 - 91 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990; Sept 1, 1991
  7. '  Copyright ..........: 1986 - 1991
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AllCaps         58050 Convert a string to all upper case characters
  18. '  AMorPM          41498 Calculate the current time as AM or PM
  19. '  AskGraphics     43004 Determine users graphic default
  20. '  BadFile         20741 Check for system crash attempt with bad device name
  21. '  Carrier         42000 Test for whether to continue in RBBS
  22. '  CheckRatio      20096 Test upload/download ratio
  23. '  CheckTime       58070 Test to insure that users don't exceed their time
  24. '  CheckCarrier    42005 Checks whether still have carrier
  25. '  CheckNewBul     58110 Check for new bulletins based on their file creation date
  26. '  CheckTimeRemain 41008 Set up to log off if time exceeded
  27. '  CommInfo        44020 Get users baud rate and parity in a string format
  28. '  CountLines      58160 Count categories a file can be classified into
  29. '  CountNewFiles   58150 Check for number of files uploaded after a specific date
  30. '  DelayTime       50495 Wait number of seconds specified before returning
  31. '  DispCall        57001 Display callers file
  32. '  DispTimeRemain  41032 Compute and display time remaining
  33. '  DispUpDir       58165 Display the shared directory of the FMS mng. sys.
  34. '  FileLock        21993 Allow files to be shared among multiple RBBS-PC's
  35. '  FindFKey        30595 Handle local keyboard's function & ZSysop's keys
  36. '  FindLast        58600 Finds last occurence of a string in a string
  37. '  FlushKeys       35000  Completely flush all user input
  38. '  Graphic         43031 Determines if graphic ver of file exists, opens as #2
  39. '  GraphicX        43031 Determines if graphic ver of file exists, any file #
  40. '  HashRBBS        58080 "Hash" to a user's record in the USERS file
  41. '  InitFMS         58162 Initialize the RBBS-PC's File Management System
  42. '  InitIBM         30000 Open/create NetBIOS semaphore file
  43. '  AddCommas       58130 Format commands in the command prompt
  44. '  Library         21105 Provide support for "library" drives
  45. '  LinesInFile     58161 Counts lines in a file
  46. '  LoadNew         58140 Find the latest uploads
  47. '  ModemPut        52070 Write a modem command string to the modem
  48. '  NameCaps        58060 Convert a string to Proper Case (for name output)
  49. '  OpenMsg         30500 Open the messages file as file number 1
  50. '  PageUp          33202 Display user info. on local screen for ZSysop
  51. '  ReadProf        44000 Read user's profile on return from a "door"
  52. '  SaveProf        43068 Save the user's provile when exiting to "doors" or DOS
  53. '  SendName        20293 Send filename via EXEC-PC protocol during autodownload
  54. '  SetOpts         58100 Set correct prompt line for each subsystem
  55. '  SortString      58120 Sort characters in a string
  56. '  TestUser        20310 Check if user's software can do auto downloading
  57. '  TimeRemain      41010 Compute time remaining in minutes
  58. '  UpdtUpload      20705 Updates upload directory file
  59. '  WildFile        20290 Determines whether string matches a pattern
  60. '  XferType        21600 Identify the file transfer protocol
  61. '
  62. '  $INCLUDE: 'RBBS-VAR.BAS'
  63. '
  64. 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
  65. ' $PAGE
  66. '  NAME    -- WildFile
  67. '
  68. '  INPUTS  -- PARAMETER             MEANING
  69. '             Pattern$           PATTERN TO CHECK AGAINST
  70. '             ItemToMatch$       FILE NAME TO MATCH
  71. '
  72. '  OUTPUTS -- DoesMatch         WHETHER MATCHES
  73. '
  74. '  PURPOSE  Determine whether a file name is an instance of
  75. '    a file specification.  Exactly like DOS except that ? must have a
  76. '    character.
  77. '
  78.       SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
  79.       IF Pattern$ <> PrevPattern$ THEN _
  80.          CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
  81.          PrevPattern$ = Pattern$
  82.       CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
  83.       DoesMatch = ZFalse
  84.       IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
  85.          EXIT SUB
  86.       CALL WildCard (PPrefix$,IPrefix$)
  87.       IF NOT ZOK THEN _
  88.          EXIT SUB
  89.       CALL WildCard (PExt$,IExt$)
  90.       DoesMatch = ZOK
  91.       END SUB
  92. 20293 ' $SUBTITLE: 'SendName - send FILENAME using EXEC-PC protocol'
  93. ' $PAGE
  94. '
  95. '  NAME    -- SendName
  96. '
  97. '  INPUTS  --  PARAMETER                    MEANING
  98. '              ZUserIn$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  99. '              ZAnsIndex                 Index OF FILENAME TO Transfer
  100. '
  101. '  OUTPUTS --  ZAbort                    -1 FOR AN ABORTED ATTEMPT
  102. '
  103. '  PURPOSE -- Send the download filename to user during an autodownload
  104. '
  105.       SUB SendName STATIC
  106. '
  107. '
  108. ' *  Transfer FILENAME TO USER
  109. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
  110. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
  111. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
  112. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
  113. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
  114. ' *                   COMPLETION AND FILE Transfer BEGINS.
  115. '
  116. '
  117.       ZAbort = ZFalse                    ' RESET ABORT FLAG
  118.       Attempts = 0                       ' RESET COUNT FOR # OF TRANS Attempts
  119. 20295 CALL DelayTime (1)                 ' ONE SECOND DELAY
  120. 20296 CALL FlushCom(ZWasY$)              ' CLEAR THE COMM BUFFER OF GARBAGE
  121.       IF ZSubParm = -1 THEN _
  122.          EXIT SUB
  123.       CALL PutCom (ZEscape$+"OD")         ' SEND "ALERT" STRING
  124.       IF ZSubParm = -1 THEN _
  125.          EXIT SUB
  126.       IF ZAbort = ZTrue THEN _
  127.          GOTO 20306
  128.       CALL LPrnt("Sending FILENAME -- ",1)
  129.       CALL LPrnt(ZReturnLineFeed$ + CHR$(9),0)
  130.       CALL DelayTime (1)                   ' WAIT 1 SECOND FOR SETUP
  131. '
  132. '               SEND ONE CHARACTER AT A TIME
  133. '
  134.       CALL BreakFileName (ZUserIn$(ZAnsIndex),WasX$,ZOutTxt$,ZWasY$,ZTrue)
  135.       ZOutTxt$ = ZOutTxt$ + ZWasY$ + "=X"
  136.       FOR WasX = 1 TO LEN(ZOutTxt$)
  137.          CALL PutCom (MID$(ZOutTxt$,WasX,1))     ' SEND 1 CHARACTER
  138.          IF ZSubParm = -1 THEN _
  139.             EXIT SUB
  140.          IF ZAbort = ZTrue THEN _
  141.             GOTO 20306
  142.          CALL LPrnt(MID$(ZOutTxt$,WasX,1),0)     ' DISPLAY IF NEEDED
  143.          ZDelay! = TIMER + 10            ' SET MAXIMUM TIME TO WAIT FOR Reply
  144.          Char = ZTrue
  145.          WHILE Char = -1
  146.             CALL CheckTime(ZDelay!, TempElapsed!, 1)
  147.             IF TempElapsed! <= 0 THEN _
  148.                GOTO 20300     ' IF ZNo ECHO, CANCEL FILENAME Transfer
  149.             CALL EofComm (Char)
  150.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  151. 20298    CALL FlushCom(ZWasY$)    ' COLLECT CHARACTER(ZWasS) USER ECHOED
  152.          IF ZSubParm = -1 THEN _
  153.             EXIT SUB
  154.          IF MID$(ZOutTxt$,WasX,1) = ZWasY$ THEN _
  155.             GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  156.          IF INSTR(ZWasY$,ZCancel$) THEN _
  157.             ZAbort = ZTrue : _
  158.             GOTO 20306          ' CHECK FOR USER ZAbort
  159. 20300    CALL PutCom (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  160.          IF ZSubParm = - 1 THEN _
  161.             EXIT SUB
  162.          IF ZAbort = ZTrue THEN _
  163.             GOTO 20306
  164.          CALL LPrnt("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  165.          Attempts = Attempts + 1  ' INCREMENT COUNTER FOR # WasOF TRIES
  166.          IF Attempts < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  167.             GOTO 20295
  168.          CALL PutCom (STRING$(50,24)) ' GUARANTEE CANCELLATION WasOF USER
  169.          IF ZSubParm = -1 THEN _
  170.             EXIT SUB
  171.          IF ZAbort = ZTrue THEN _
  172.             GOTO 20306
  173.          IF ZSnoop THEN _
  174.             CALL LPrnt("ABORTING AUTODOWNLOAD!",1) : _
  175.             ZAbort = ZTrue : _
  176.             GOTO 20306
  177. '
  178. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  179. '
  180.       CALL PutCom (ZAcknowledge$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  181.       IF ZSubParm = -1 THEN _
  182.          EXIT SUB
  183.       CALL SkipLine(1)              ' CLEAN UP Sysop's DISPLAY
  184. '
  185. '                COMPLETION OF AUTODOWNLOAD FILENAME Transfer
  186. '
  187. 20306 END SUB
  188. 20310 ' $SUBTITLE: 'TestUser - interrogate user for AUTO-Downloading support'
  189. ' $PAGE
  190. '
  191. '  NAME    -- TestUser
  192. '
  193. '  INPUTS  -- NONE
  194. '
  195. '  OUTPUTS -- ZAutoDownYes         -1 IF USER'S COMMUNICATION
  196. '                                  SOFTWARE CAN DO AUTODOWNLOADING
  197. '
  198. '             ZAutoDownVerified    TRUE IF COMMUNICATIONS PGM
  199. '                                  EVER CHECKED
  200. '
  201. '  PURPOSE -- Send the user an <ESCAPE><XON> and if response
  202. '             is a recognized package, set appropriate flag.
  203. '
  204.       SUB TestUser STATIC
  205. '
  206. '
  207. ' *    TEST FOR COMMUNICATIONS USING WasN,8,1 Protocol AND EXECPC Talk VER 2.0+
  208. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE
  209. '
  210. '
  211.       ZAbort = ZFalse
  212.       ZAutoDownVerified = ZTrue
  213.       CALL FlushCom(ZWasY$)                          ' FLUSH THE COMM BUFFER
  214.       IF ZSubParm = -1 THEN _
  215.          EXIT SUB
  216.       CALL PutCom (ZEscape$ + ZXOn$)
  217.       IF ZAbort = ZTrue THEN _
  218.          GOTO 20315
  219.       CALL DelayTime (2)                         ' WAIT TWO SECONDS FOR Reply
  220. 20313 CALL FlushCom(ZWasY$)                      ' GET CONTENTS OF COMM BUFFER
  221.       IF ZSubParm = -1 THEN _
  222.          EXIT SUB
  223.       IF INSTR(ZWasY$,"EXECPC") THEN _
  224.          ZComProgram = 1
  225.       IF INSTR(ZWasY$,"PIBTERM") THEN _
  226.          ZComProgram = 2
  227.       IF INSTR(ZWasY$,"PROCOMM") THEN _
  228.          ZComProgram = 3
  229.       IF INSTR(ZWasY$,"QMODEM") THEN _
  230.          ZComProgram = 4
  231.       ZAutoDownYes = (ZComProgram > 0 AND ZComProgram < 3)
  232. 20315 END SUB
  233. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  234. ' $PAGE
  235. '  NAME    -- UpdtUpload
  236. '
  237. '  INPUTS  -- PARAMETER             MEANING
  238. '             ZFileName$
  239. '             ZUpldDir$
  240. '             ZFileNameHold$
  241. '             ZShareIt
  242. '             ZFMSDirectory$
  243. '             ZWasQ!
  244. '             ZSecsUsedSession!
  245. '
  246. '  OUTPUTS -- ZBytesInFile#
  247. '             ZSecsPerSession!
  248. '
  249. '  PURPOSE -- Upon a successful upload, add entry to the upload
  250. '             directory and give any session time credit.
  251. '
  252.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC
  253.       IF ZGetExtDesc THEN _
  254.          GOTO 20723
  255.       GOSUB 20734
  256.       CALL TimeRemain (MinsRemaining)
  257.       IF ZPrivateDoor THEN _
  258.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  259.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  260.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  261.       WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
  262.       CALL FindIt (WasX$)
  263.       IF NOT ZOK THEN _
  264.          GOTO 20708
  265.       CALL QuickTPut1 ("Testing upload...") : _
  266.       CALL ReadDir (2,1)
  267.       IF EOF(2) THEN _
  268.          WasX$ = ZOutTxt$ : _
  269.          ZGSRAra$(1) = ZFileName$ : _
  270.          ZGSRAra$(2) = ZNodeWorkFile$ _
  271.       ELSE WasX$ = WasX$ + " " + _
  272.            ZFileName$ + " " + ZNodeWorkFile$
  273.       CALL ShellExit (WasX$)
  274.       CALL FindIt (ZNodeWorkFile$)
  275.       IF ZOK THEN _
  276.          IF LOF(2) > 2 THEN _
  277.             ZBytesInFile# = 0.0 : _
  278.             WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _
  279.             CALL QuickTPut1 (WasX$) : _
  280.             CALL UpdtCalr (WasX$,2) : _
  281.             CALL KillWork (ZFileName$) : _
  282.             EXIT SUB
  283. 20708 WasX$ = ZDiskForDos$ + "C" + Ext$ + ZDefaultExtension$ + ".BAT"
  284.       CALL FindIt (WasX$)
  285.       IF NOT ZOK THEN _
  286.          GOTO 20709
  287.       ZOutTxt$ = "Converting"
  288.       IF Ext$ = ZDefaultExtension$ THEN _
  289.          ZOutTxt$ = "Re-" + ZOutTxt$
  290.       CALL QuickTPut1 (ZOutTxt$ + " upload to "+ZDefaultExtension$+".  Please wait...")
  291.       CALL ReadDir (2,1)
  292.       IF EOF(2) THEN _
  293.          WasX$ = ZOutTxt$
  294.       ZGSRAra$(1) = ZFileName$
  295.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
  296.       ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
  297.       ZUserIn$(0) = ZFileName$
  298.       ZFileName$ = Pre$ + ZFileNameHold$
  299.       CALL ShellExit (WasX$ + " " + Body$ + " " + ZNodeID$)
  300.       CALL FindIt (ZFileName$)
  301.       IF NOT ZOK THEN _
  302.          ZFileName$ = ZGSRAra$(1) : _
  303.          CALL FindIt (ZFileName$) : _
  304.          ZFileNameHold$ = Body$ + Ext$ : _
  305.          IF ZOK THEN _
  306.             GOTO 20709
  307.       GOSUB 20736
  308. 20709 CALL QuickTPut1 ("Upload successful")
  309.       WasX$ = DATE$
  310.       ZWasZ$ = LEFT$(WasX$,6) + _
  311.            RIGHT$(WasX$,2)
  312.       StrewTo$ = ""
  313.       UCat$ = ""
  314. 20710 CALL QuickTPut1 ("Describe " + ZFileNameHold$ + _
  315.            " (Begin with '/' if for SysOp only)")
  316.       CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  317.                  ZMaxDescLen - 4) + "..Max>")
  318.       CALL QuickTPut ("? ",0)
  319.       ZOutTxt$ = ""
  320.       ZSubParm = 1
  321.       ZParseOff = ZTrue
  322.       CALL TGet
  323.       CALL Carrier
  324.       IF ZSubParm = -1 THEN _
  325.          ZUserIn$ = "<description unavailable>": _
  326.          GOTO 20712
  327.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _
  328.          CALL QuickTPut1 ("10 chars min," + STR$(ZMaxDescLen) + " max") : _
  329.          GOTO 20710
  330. 20712 ZOK = 0
  331.       CALL CheckNovell (ZOK)
  332.       IF ZOK <> -1 THEN _
  333.          CALL SetSharedAttr (ZFileName$, ZOK) : _
  334.          IF ZOK <> 0 THEN _
  335.             CALL PScrn ("Error setting to shared")
  336.       Desc$ = ZUserIn$
  337.       IF NOT ZLimitSearchToFMS THEN _
  338.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _
  339.             IF LEFT$(ZUserIn$,1) = "/" THEN _
  340.                CALL UpdtCalr (ZUserIn$,2) : _
  341.                GOTO 20726_
  342.             ELSE GOTO 20717
  343. 20715 IF LEFT$(ZUserIn$,1) = "/" THEN _
  344.          UCat$ = "***" : _
  345.          GOTO 20722
  346.       UCat$ = ZDefaultCatCode$
  347. 20717 IF ZSubParm = -1 OR _
  348.          ZUserSecLevel < ZSLCategorizeUplds THEN _
  349.          GOTO 20722
  350. 20719 CALL BufFile (ZUpcatHelp$,WasX)
  351. 20720 ZOutTxt$= "Upload best fits what category (D=default,H=help)"
  352.       ZSubParm = 1
  353.       CALL TGet
  354.       CALL AraAllCaps (ZUserIn$(),1)
  355.       IF ZSubParm = -1 OR ZUserIn$(1) = "D" THEN _
  356.          UCat$ = ZDefaultCatCode$ : _
  357.          GOTO 20722
  358.       IF ZWasQ = 0 THEN _
  359.          GOTO 20719
  360.       IF ZUserIn$(1) = "H" OR _
  361.          ZUserIn$(1) = "*" OR _
  362.          ZUserIn$(1) = "?" THEN _
  363.          GOTO 20719
  364.       CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
  365.       IF Found > 0 THEN _
  366.          UCat$ = ZCategoryCode$(Found) : _
  367.          IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _
  368.             GOTO 20722
  369.       UCat$ = ""
  370.       IF NOT ZLimitSearchToFMS THEN _
  371.          StrewTo$ = ZDirPath$ + _
  372.                      ZUserIn$(1) + _
  373.                      "." + _
  374.                      ZDirExtension$ : _
  375.          CALL FindIt (StrewTo$) : _
  376.          IF ZOK THEN _
  377.             GOTO 20722 _
  378.          ELSE CALL WordInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
  379.               IF ZOK THEN _
  380.                  GOTO 20722
  381.       StrewTo$ = ""
  382.       CALL QuickTPut1 ("No such category " + ZUserIn$(1))
  383.       GOTO 20719
  384. 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
  385.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  386.          ZOutTxt$ = "Add an extended description of " + _
  387.               ZFileNameHold$ + " ([Y],N)" : _
  388.          ZTurboKey = -ZTurboKeyUser : _
  389.          ZSubParm = 1 : _
  390.          CALL TGet : _
  391.          IF ZSubParm <> -1 THEN _
  392.             IF NOT ZNo THEN _
  393.                ZGetExtDesc = ZTrue : _
  394.                EXIT SUB
  395. 20723 ZUserIn$ = Desc$
  396.       WasX$ = DATE$
  397.       ZWasZ$ = LEFT$(WasX$,6) + _
  398.            RIGHT$(WasX$,2)
  399.       ZWasEN$ = StrewTo$
  400.       GOSUB 20730
  401.       ZWasEN$ = ZAllwaysStrewTo$
  402.       GOSUB 20730
  403. 20725 ZWasEN$ = ZUpldDir$
  404.       GOSUB 20730
  405. 20726 ZWasDF$ = " >> uploaded << "
  406.       ZUplds = ZUplds + 1
  407.       ZGlobalUplds = ZGlobalUplds + 1
  408.       ZULBytes! = ZULBytes! + ZBytesInFile#
  409.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  410.       CALL Muzak (7)
  411.       CALL TimeRemain (MinsRemaining)
  412.       MinsToAdd = WasX! / 60
  413.       CALL ChkAddedTime (MinsToAdd)
  414.       WasX! = MinsToAdd * 60!
  415.       ZTimeCredits! = ZTimeCredits! + WasX!
  416.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  417.       IF ZPrivateDoor THEN _
  418.          WasX! = (WasX! - ZWasQ!) / 60 _
  419.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  420.       WasX$ = STR$(FIX(WasX!*10.0))
  421.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  422.       IF WasX! > 1 THEN _
  423.          CALL QuickTPut1 ("Increased session time by"+WasX$+" minutes")
  424.       CALL QuickTPut1 ("Thanks for the upload!")
  425.       ZGetExtDesc = ZFalse
  426.       EXIT SUB
  427. 20730 '          ---[ lock file ]---
  428.       IF ZWasEN$ = "" THEN _
  429.          RETURN
  430.       FMSFormat = ZFalse
  431.       IF ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS THEN _
  432.          FMSFormat = ZTrue _
  433.       ELSE CALL FindIt (ZWasEN$) : _
  434.            IF ZOK THEN _
  435.               CALL ReadDir (2,1) : _
  436.               IF ZErrCode = 0 THEN _
  437.                  FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
  438.       IF NOT FMSFormat THEN _
  439.          ReadBackwards = ZFalse : _
  440.          FixedLen = 0 : _
  441.          ZUserIn$ = Desc$ _
  442.       ELSE FixedLen = 34 + ZMaxDescLen : _
  443.            ZUserIn$ = Desc$ + _
  444.                 SPACE$(ZMaxDescLen - LEN(Desc$)) + _
  445.                 UCat$ + _
  446.                 SPACE$(3 - LEN(UCat$)) : _
  447.            ReadBackwards = ZTrue : _
  448.            CALL FindIt (ZWasEN$) : _
  449.            IF ZOK THEN _
  450.               CALL ReadDir (2,1) : _
  451.               IF ZErrCode = 0 THEN _
  452.                  ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
  453.       CALL LockAppend
  454.       IF ZErrCode <> 0 THEN _
  455.          GOTO  20731
  456.       '          ---[ append ]---
  457.       IF ZGetExtDesc THEN _
  458.          IF ReadBackwards THEN _
  459.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  460.                GOSUB 20732 : _
  461.             NEXT
  462.       PRINT #2,USING "\           \########  &  &"; _
  463.                      ZFileNameHold$; _
  464.                      ZBytesInFile#; _
  465.                      ZWasZ$; _
  466.                      ZUserIn$
  467.       IF ZGetExtDesc THEN _
  468.          IF NOT ReadBackwards THEN _
  469.             FOR WasI = 1 TO LinesInDesc : _
  470.                GOSUB 20732 : _
  471.             NEXT
  472. 20731 CALL UnLockAppend
  473.       FixedLen = 0
  474.       RETURN
  475. 20732 WasX$ = ZOutTxt$(WasI)
  476.       CALL Trim (WasX$)
  477.       IF WasX$ = "" THEN _
  478.          RETURN
  479.       IF NOT FMSFormat THEN _
  480.          PRINT #2,"  ";ZOutTxt$(WasI) : _
  481.          RETURN
  482.       IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
  483.          WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
  484.       ELSE WasX$ = ""
  485.       PRINT #2, "  ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
  486.       RETURN
  487. 20734 CALL FindIt (ZFileName$)
  488. 20736 IF NOT ZOK THEN _
  489.          ZBytesInFile# = 0.0_
  490.       ELSE ZBytesInFile# = LOF(2)
  491.       IF ZBytesInFile# < 2.0 THEN _
  492.          EXIT SUB
  493.       RETURN
  494.       END SUB
  495. 20741 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'
  496. ' $PAGE
  497. '
  498. '  NAME    -- BadFile
  499. '
  500. '  INPUTS  --     PARAMETER                    MEANING
  501. '               ZViolation$
  502. '               ZViolationsThisSession
  503. '               FilName$                      NAME OF FILE
  504. '
  505. '  OUTPUTS -- Result                      1 = FILE NAME IS OK
  506. '                                         2 = CHARACTER NOT ALLOWED
  507. '                                         3 = SYSTEM CRASH ATTEMPT
  508. '             ZViolationsThisSession     NUMBER OF VIOLATIONS
  509. '             FilName$                    Gets capitalized
  510. '
  511. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  512. '             to either crash the system or to breach RBBS-PC's security.
  513. '
  514.       SUB BadFile (FilName$,Result) STATIC
  515. '
  516. '
  517. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  518. '
  519. '
  520.       Result = 2
  521.       IF LEN(FilName$) < 1 THEN _
  522.          EXIT SUB
  523.       CALL BadFileChar (FilName$,ZOK)
  524.       IF NOT ZOK THEN _
  525.          EXIT SUB
  526.       CALL AllCaps (FilName$)
  527.       WasXX = INSTR(FilName$,".")
  528.       IF WasXX > 0 THEN _
  529.          IF WasXX < LEN(FilName$) THEN _
  530.             WasXX = INSTR(WasXX + 1,FilName$,".") : _
  531.             IF WasXX > 0 THEN _
  532.                EXIT SUB
  533.       WasXX = LEN(FilName$)
  534.       IF WasXX => 3 THEN _
  535.          IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
  536.             GOTO 20742
  537.       IF WasXX => 4 THEN _
  538.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _
  539.             GOTO 20742
  540.       CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
  541.       IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
  542.          EXIT SUB
  543.       WasXX = LEN(Body$)
  544.       IF WasXX => 3 THEN _
  545.          IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
  546.             GOTO 20742
  547.       IF WasXX => 4 THEN _
  548.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _
  549.             GOTO 20742
  550.       Result = 1
  551.       EXIT SUB
  552. 20742 ZViolationsThisSession = ZMaxViolations
  553.       ZViolation$ = ZViolation$ + _
  554.                    FilName$
  555.       Result = 3
  556.       END SUB
  557. '
  558. 21105 ' $SUBTITLE: 'Library - sub to support Library downloads'
  559. ' $PAGE
  560. '
  561. '  NAME    -- Library
  562. '
  563. '  INPUTS  --     PARAMETER                    MEANING
  564. '              ZSubParm                 1 = DISPLAY ACTIVE AREA
  565. '                                       2 = CHANGE ACTIVE AREA
  566. '                                       3 = DISPLAY PC-SIG
  567. '                                           DISCLAIMER
  568. '                                       4 = ARCHIVE Library DISK
  569. '                                       5 = DOWNLOAD COMPLETED
  570. '              ZLibType                 0 = No Library ACTIVE
  571. '                                       1 = Library FROM PC-SIG
  572. '              ZLibDrive$                   Library DRIVE ID
  573. '
  574. '  OUTPUTS -- NONE
  575. '
  576. '  PURPOSE -- To provide access support for library drives
  577. '
  578.       SUB Library STATIC
  579.       STATIC LibSubdirName$(1)
  580.       STATIC DiskTitle$
  581.       ZErrCode = 0
  582.       IF ZLibType = 0 THEN _
  583.          EXIT SUB
  584.       IF ZLibDiskChar$ = "" THEN _
  585.          ZLibDiskChar$ = "0000"
  586.       ON ZSubParm GOTO 21110, 21115, 21130, 21140, 21159
  587. 21110 IF ZLibDiskChar$ = "0000" THEN _
  588.          ZOutTxt$ = "No Library disk currently selected" _
  589.       ELSE ZOutTxt$ = "Library disk " + _
  590.                 ZLibDiskChar$ + _
  591.                 " selected - " + _
  592.                 DiskTitle$
  593.       CALL QuickTPut1 (ZOutTxt$)
  594.       IF LibDiskArc$ = "" THEN _
  595.          EXIT SUB
  596.       IF INSTR(ZLibArcProgram$,"ARC") THEN _
  597.          Extension$ = "ARC" _
  598.       ELSE IF INSTR(ZLibArcProgram$,"ZIP") THEN _
  599.          Extension$ = "ZIP" _
  600.       ELSE IF INSTR(ZLibArcProgram$,"LHA") THEN _
  601.          Extension$ = "LHZ" _
  602.       ELSE Extension$ = ZDefaultExtension$
  603.       FOR LibDisplayCount = 0 TO LibLoopCount - 1
  604.          IF LibSubdirName$(LibDisplayCount) <> "" THEN _
  605.             CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _
  606.                        "." + Extension$ + " ready for transmission!")
  607.       NEXT
  608.       EXIT SUB
  609. 21115 IF ZWasQ = 1 THEN _
  610.          ZOutTxt$ = "Change Library disk from " + _
  611.               ZLibDiskChar$ + _
  612.               " to (1 -" + _
  613.               STR$(ZLibMaxDisk) + _
  614.               ")" : _
  615.          ZSubParm = 1 : _
  616.          CALL TGet : _
  617.          IF ZSubParm = -1 THEN _
  618.             EXIT SUB _
  619.          ELSE IF ZWasQ = 0 THEN _
  620.                  ZLibDiskChar$ = "0000" : _
  621.                  ChdirLib$ = ZLibDrive$ + _
  622.                                   "\" : _
  623.                  GOTO 21126
  624. 21117 IF VAL(ZUserIn$(ZWasQ)) < 1 OR VAL(ZUserIn$(ZWasQ)) > ZLibMaxDisk THEN _
  625.          ZWasQ = 1 : _
  626.          GOTO 21115
  627. 21120 ZLibDiskChar$ = ZUserIn$(ZWasQ)
  628.       CLOSE 2
  629.       ZLibDiskChar$ = RIGHT$("0000" + ZLibDiskChar$,4)
  630. 21121 CALL FindIt("RBBS-CDR.DEF")
  631.       IF NOT ZOK THEN _
  632.          EXIT SUB
  633. 21122 IF EOF(2) THEN _
  634.          ZLibDiskChar$ = "" : _
  635.          EXIT SUB
  636.       INPUT #2,WorkSubdir$,ChdirLib$
  637.       LINE INPUT #2,DiskTitle$
  638.       IF ZLibDiskChar$ = WorkSubdir$ THEN _
  639.          ChdirLib$ = ZLibDrive$ + _
  640.                           ChdirLib$ : _
  641.          GOTO 21126
  642.       GOTO 21122
  643. 21126 ZErrCode = 0
  644.       CALL ChangeDir (ChdirLib$)
  645.       IF ZErrCode <> 0 THEN _
  646.          ZLibDiskChar$ = "0000" : _
  647.          ChdirLib$ = ZLibDrive$ + _
  648.                           "\" : _
  649.          GOTO 21126
  650.       EXIT SUB
  651. 21130 IF ZLibType <> 1 THEN _
  652.          EXIT SUB
  653.       CALL SkipLine(1)
  654.       ZOutTxt$ = "The PC-SIG Library file that you are about to"
  655.       CALL QuickTPut1 (ZOutTxt$)
  656.       ZOutTxt$ = "download can also be ordered as DISK " + _
  657.            ZLibDiskChar$
  658.       CALL QuickTPut1 (ZOutTxt$)
  659.       ZOutTxt$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  660.       CALL QuickTPut (ZOutTxt$,2)
  661.       EXIT SUB
  662. 21140 IF ZLibDiskChar$ = "0000" THEN _
  663.          CALL QuickTPut1 ("First select a Library disk!") : _
  664.          EXIT SUB
  665.       ZOutTxt$ = "Archive files in Library disk - " + _
  666.            ZLibDiskChar$ + _
  667.            " for download (Y,[N])"
  668.       ZSubParm = 1
  669.       CALL TGet
  670.       IF NOT ZLocalUser THEN _
  671.          IF ZSubParm = -1 THEN _
  672.             EXIT SUB
  673.       IF NOT ZYes THEN _
  674.          EXIT SUB
  675. 21145 CALL KillWork (ZLibWorkDiskPath$ + _
  676.                     ZLibNodeID$ + _
  677.                     "DK*." + Extension$)
  678. 21150 CALL QuickTPut1 ("Work/RAM disk purged")
  679.       CALL QuickTPut1 ("Archiving with " + _
  680.                   ZLibArcProgram$ + _
  681.                   " Please be patient!")
  682.       REDIM LibSubdirName$(10)
  683.       LibSubdirChar$ = ""
  684.       LibLoopCount = 0
  685.       GOSUB 21157
  686.       ZOutTxt$ = "Contents of Library disk - " + _
  687.            ZLibDiskChar$ + _
  688.            " now archived for download"
  689.       CALL QuickTPut1 (ZOutTxt$)
  690.       ZOutTxt$ = "Searching for Sub-directories"
  691.       CALL QuickTPut1 (ZOutTxt$)
  692.       GOSUB 21158
  693.       LibDiskArc$ = ZLibDiskChar$
  694. '
  695. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  696. '
  697.       Treedir$ = ZLibWorkDiskPath$ + _
  698.                  ZLibNodeID$ + _
  699.                  "DKDIR.LST"
  700.       DirCmd$ = "DIR " + _
  701.                 ZLibDrive$ + _
  702.                 " | FIND " +  _
  703.                 CHR$(34) + _
  704.                 " <DIR> " + _
  705.                 CHR$(34) + _
  706.                 "  > " + _
  707.                 Treedir$
  708. 21151 SHELL DirCmd$
  709.       CALL SkipLine (2)
  710.       LOCATE 24,1
  711.       ZErrCode = 0
  712. 21152 CLOSE 2
  713. 21153 CALL OpenWork (2,Treedir$)
  714.       LibSubdirCount = 0
  715.       WHILE NOT EOF(2)
  716.          LINE INPUT #2, Dirrec$
  717.          IF LEFT$(Dirrec$,1) <> "." THEN _
  718.             LibSubdirCount = LibSubdirCount + 1 : _
  719.             LibSubdirName$(LibSubdirCount) = _
  720.             LEFT$(Dirrec$,8)
  721.       WEND
  722.       CLOSE 2
  723.       LibLoopCount = 1
  724.       IF LibSubdirCount = 0 THEN _
  725.          GOTO 21156
  726.       ZOutTxt$ = STR$(LibSubdirCount) + _
  727.            " Subdirectories on Library disk - " + _
  728.            ZLibDiskChar$
  729.       CALL QuickTPut1 (ZOutTxt$)
  730.       FOR LibLoopCount = 1 TO LibSubdirCount
  731.          IF NOT ZLocalUser THEN _
  732.             CALL Carrier : _
  733.             IF ZSubParm THEN _
  734.                GOTO 21155
  735.          LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1)
  736.          ZOutTxt$ = "Creating " + _
  737.               ZLibNodeID$ + _
  738.               "DK" + _
  739.               ZLibDiskChar$ + _
  740.               LibSubdirChar$ + "." + Extension$ + _
  741.               " using " + ZLibArcProgram$
  742.          CALL QuickTPut1 (ZOutTxt$)
  743.          CHDIR ChdirLib$ + _
  744.                "\" + _
  745.                LibSubdirName$(LibLoopCount)
  746.          GOSUB 21157
  747.          ZOutTxt$ = "Disk - " + _
  748.               ZLibDiskChar$ + _
  749.               "; Subdirectory" + _
  750.               " -" + _
  751.               STR$(LibLoopCount) + _
  752.               " archived for download"
  753.          CALL QuickTPut1 (ZOutTxt$)
  754.          GOSUB 21158
  755. 21155 NEXT LibLoopCount
  756. 21156 CALL Carrier
  757.       ZOutTxt$ = ""
  758.       EXIT SUB
  759. 21157 LibArc$ = ZLibArcPath$ + _
  760.                        ZLibArcProgram$ + _
  761.                        " " + _
  762.                        ZLibWorkDiskPath$ + _
  763.                        ZLibNodeID$ + _
  764.                        "DK" + _
  765.                        ZLibDiskChar$ + _
  766.                        LibSubdirChar$ + _
  767.                        " " + _
  768.                        ZLibDrive$ + _
  769.                        "*.*"
  770.       IF ZUseDeviceDriver$ <> "" AND ZFossil AND NOT ZLocalUser THEN _
  771.          LibArc$ = ZDiskForDos$ + _
  772.                             "COMMAND /C " + _
  773.                             LibArc$ + _
  774.                             " > " + _
  775.                             ZUseDeviceDriver$
  776.       SHELL LibArc$
  777.       CALL SkipLine (2)
  778.       LOCATE 24,1
  779.       RETURN
  780. 21158 LibSubdirName$(LibLoopCount) = ZLibNodeID$ + _
  781.                                              "DK" + _
  782.                                              ZLibDiskChar$ + _
  783.                                              LibSubdirChar$
  784.       RETURN
  785. 21159 FOR LibDisplayCount = 0 TO LibLoopCount - 1
  786.          IF LibSubdirName$(LibDisplayCount) = ZOutTxt$ THEN _
  787.             LibSubdirName$(LibDisplayCount) = ""
  788.       NEXT
  789.       END SUB
  790. 21598 ' $SUBTITLE: 'XferType - sub to identify file xfer protocol'
  791. ' $PAGE
  792. '
  793. '  NAME    -- XferType
  794. '
  795. '  INPUTS  --     PARAMETER                    MEANING
  796. '               Index            = 1       Manual select for up/download
  797. '                                = 2       Default select
  798. '                                = 3       Set transfer default
  799. '               ZOutTxt$
  800. '               ZUserIn$(1)
  801. '               ZWasQ
  802. '               ZReliableMode
  803. '               ZTransferOption$
  804. '               ZUserXferDefault$
  805. '               ZXferSupport
  806. '
  807. '  OUTPUTS   -- ZCheckSum
  808. '               ZFLen
  809. '               ZWasFT$
  810. '
  811. '  PURPOSE -- To identify the file transfer protocol (either
  812. '             from the user's default or via explicit selection)
  813. '
  814.       SUB XferType (Index,SkipHelp) STATIC
  815.       IF ZTransferOption$ = "" OR ZUserSecLevel <> PrevUSL THEN _
  816.          CALL Protocol : _
  817.          PrevUSL = ZUserSecLevel
  818.       WasX$ = ZOutTxt$ + "Protocol"
  819.       ON Index GOTO 21600,21620,21600
  820. '
  821. '
  822. ' *  MANUAL SELECT OF Transfer Protocol
  823. '
  824. '
  825. 21600 IF SkipHelp THEN _
  826.          GOTO 21604
  827. 21602 CALL BufFile (ZHelpPath$ + "UF" + ZHelpExtension$,WasX)
  828.       IF ZSubParm = -1 THEN _
  829.          EXIT SUB
  830. 21604 ZStopInterrupts = ZTrue
  831.       IF Index = 3 THEN _
  832.          IF ZAnsIndex < ZLastIndex THEN _
  833.             GOTO 21605
  834.       CALL QuickTPut1 (WasX$)
  835.       CALL BufString (ZTransferOption$,4096,WasX)
  836.       CALL QuickTPut (MID$("?!",1-ZTurboKeyUser,1)+" ",0)
  837. 21605 ZOutTxt$ = ""
  838.       ZTurboKey = -ZTurboKeyUser
  839.       ZMacroMin = 2
  840.       ZSubParm = 1
  841.       ZSuspendAutoLogoff = ZTrue
  842.       ZStackC = ZTrue
  843.       IF Index = 3 THEN _
  844.          CALL PopCmdStack : _
  845.          WasX = ZAnsIndex _
  846.       ELSE ZSubParm = 1 : _
  847.            CALL TGet : _
  848.            WasX = 1
  849.       ZSuspendAutoLogoff = ZFalse
  850.       IF ZSubParm = -1 THEN _
  851.          EXIT SUB
  852.       IF ZWasQ = 0 THEN _
  853.          GOTO 21604
  854. 21606 ZWasZ$ = ZUserIn$(WasX)
  855. '
  856. '
  857. ' *  DEFAULT SELECT OF Transfer Protocol
  858. '
  859. '
  860. 21610 CALL AllCaps (ZWasZ$)
  861.       ZFF = INSTR(ZDefaultXfer$,ZWasZ$)
  862.       IF ZFF > 0 THEN _
  863.          GOTO 21612
  864.       IF INSTR("H?",ZWasZ$) > 0 THEN _
  865.          GOTO 21602
  866.       GOTO 21600
  867. 21612 ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1)
  868.       ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
  869.       GOTO 21621
  870. 21620 ZFF = -1
  871.       IF ZCmdTransfer$ <> "" THEN _
  872.          ZWasZ$ = ZCmdTransfer$ : _
  873.          GOTO 21610
  874.       WasX = INSTR(ZDefaultXfer$,ZUserXferDefault$)
  875.       IF WasX > 0 THEN _
  876.          IF MID$(ZInternalEquiv$,WasX,1) <> "N" THEN _
  877.             ZWasZ$ = ZUserXferDefault$ : _
  878.             GOTO 21610
  879.       ZProtoPrompt$ = "None"
  880.       ZFF = 0
  881.       EXIT SUB
  882. 21621 IF ZFF = PrevFF AND PrevProtoDef$ = ZProtoDef$ THEN _
  883.          ZProtoPrompt$ = PrevProtoPrompt$ : _
  884.          EXIT SUB
  885.       PrevFF = ZFF
  886.       PrevProtoDef$ = ZProtoDef$
  887.       ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
  888.       ZCheckSum = (ZInternalProt$ = "X")
  889.       CALL FindIt (ZProtoDef$)
  890.       IF ZOK THEN _
  891.          GOTO 21623
  892.       WasX = INSTR("AXCYN",ZInternalProt$)
  893.       IF WasX < 1 THEN _
  894.          ZInternalProt$ = "N"
  895.       ZProtoPrompt$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",ZInternalProt$)-9,10)
  896.       CALL TrimTrail (ZProtoPrompt$," ")
  897.       ZCheckSum = (ZInternalProt$ = "X")
  898.       ZFLen = 128 - 896 * (ZInternalProt$ = "Y")
  899.       ZBlockSize = ZFLen
  900.       IF ZInternalProt$ = "Y" THEN _
  901.          ZSpeedFactor! = 0.87 _
  902.       ELSE IF ZInternalProt$ = "A" THEN _
  903.          ZSpeedFactor! = 0.92 _
  904.       ELSE ZSpeedFactor! = 0.78
  905.       GOTO 21625
  906. 21623 CALL ReadParms (ZWorkAra$(),13,ZFF)
  907.       IF ZErrCode > 0 THEN _
  908.          ZFF = LEN(ZDefaultXfer$) : _
  909.          ZProtoPrompt$ = "None" : _
  910.          GOTO 21625
  911.       ZProtoPrompt$ = ZWorkAra$(1)
  912.       IF LEN(ZProtoPrompt$) > 2 THEN _
  913.          IF MID$(ZProtoPrompt$,2,1) = ")" THEN _
  914.             ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3)
  915.       WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$)
  916.       ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1)
  917.       CALL Trim (ZProtoPrompt$)
  918.       ZProtoMethod$ = LEFT$(ZWorkAra$(3),1)
  919.       CALL AllCaps (ZProtoMethod$)
  920.       ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8")
  921.       ZDownTemplate$ = ZWorkAra$(12)
  922.       ZUpTemplate$ = ZWorkAra$(13)
  923.       WasX$ = ZWorkAra$(11)
  924.       WasX = INSTR(WasX$,"=")
  925.       ZAdvanceProtoWrite = ZFalse
  926.       IF WasX < 2 OR WasX >= LEN(WasX$) THEN _
  927.          ZFailureParm = 4 : _
  928.          ZFailureString$ = "F" _
  929.       ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _
  930.            ZFailureString$ = MID$(WasX$,WasX+1) : _
  931.            WasX = INSTR(ZFailureString$,"=") : _
  932.            IF WasX > 0 THEN _
  933.               ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _
  934.               ZFailureString$ = LEFT$(ZFailureString$,WasX-1)
  935.       ZProtoMacro$ = ZWorkAra$(10)
  936.       ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F")
  937.       ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B")
  938.       ZSpeedFactor! = VAL(ZWorkAra$(9))
  939.       IF ZSpeedFactor! < 0.1 THEN _
  940.          ZSpeedFactor! = 0.87
  941.       ZBlockSize = VAL(ZWorkAra$(7))
  942.       ZFLen = ZBlockSize
  943.       IF ZFLen < 1 THEN _
  944.          ZFLen = 128
  945. 21625 PrevProtoPrompt$ = ZProtoPrompt$
  946.       END SUB
  947. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  948. ' $PAGE
  949. '
  950. '  NAME    -- FileLock
  951. '
  952. '  INPUTS  --     PARAMETER                    MEANING
  953. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  954. '                                      2 FLUSH MESSAGE RECORD TO DISK
  955. '                                        AND UNLOCK MESSAGES
  956. '                                      3 LOCK MESSAGE FILE
  957. '                                      4 UNLOCK MESSAGE FILE
  958. '                                      5 LOCK USER FILE
  959. '                                      6 LOCK 4 RECORD BLOCK IN USER
  960. '                                        FILE
  961. '                                      7 UNLOCK USER FILE
  962. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  963. '                                        FILE
  964. '                                      9 LOCK UPLOAD DIRECTORY OR
  965. '                                        COMMENTS FILE
  966. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  967. '                                        COMMENTS FILE
  968. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  969. '               ZActiveUserFile$         NAME OF USER FILE
  970. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  971. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  972. '                                        FILE NAME TO LOCK/UNLOCK
  973. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  974. '
  975. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  976. '             ZBlk
  977. '             ZLockDrive
  978. '             ZLockFileName$
  979. '             ZLockStatus$
  980. '             ZMsgFileLock
  981. '             ZUserBlockLock
  982. '             ZUserFileLock
  983. '             ZUserFileIndex
  984. '
  985. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  986. '             multiple copies of RBBS-PC are sharing the same
  987. '             files in either a multi-tasking DOS environment or
  988. '             in a local area network environment
  989. '
  990.       SUB FileLock STATIC
  991.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  992.                                     26500,27000,27500,29000,29500
  993.       EXIT SUB
  994. '
  995. '
  996. ' *  UNLOCK USERS AND MESSAGES
  997. '
  998. '
  999. 21995 GOSUB 27000
  1000.       GOSUB 25000
  1001.       RETURN
  1002. '
  1003. '
  1004. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  1005. '
  1006. '
  1007. 21996 CLOSE 1
  1008.       IF ZShareIt THEN _
  1009.          OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _
  1010.       ELSE OPEN "I",1,ZConfigFileName$
  1011. '
  1012. '
  1013. ' *  UNLOCK MESSAGES
  1014. '
  1015. '
  1016.       GOSUB 25000
  1017.       CALL OpenMsg
  1018.       RETURN
  1019. '
  1020. '
  1021. ' *  LOCK MESSAGE FILE
  1022. '
  1023. '
  1024. 22000 IF ZMsgFileLock = ZTrue THEN _
  1025.          RETURN
  1026.       ZMsgFileLock = ZTrue
  1027.       MID$(ZLockStatus$,1,2) = "LM"
  1028.       ZSubParm = 2
  1029.       CALL Line25
  1030.       ZLockFileName$ = ZActiveMessageFile$
  1031.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  1032.       RETURN
  1033. '
  1034. '
  1035. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  1036. '
  1037. '
  1038. 22100 WasAX = &H0
  1039.       WasBX = &H1
  1040.       IF ZMultiLinkPresent > 0 THEN _
  1041.          CALL RBBSML(WasAX,WasBX)
  1042.       RETURN
  1043. '
  1044. '
  1045. ' *  LOCK MESSAGE FILE (OMNINET)
  1046. '
  1047. '
  1048. 22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1049.       WasCC$ = CHR$(1) + _
  1050.             LEFT$(Prefix$ + SPACE$(8),8)
  1051.       GOSUB 28000
  1052.       IF WasCT = 0 THEN _
  1053.          RETURN
  1054.       CALL DelayTime (1)
  1055.       GOTO 22200
  1056. '
  1057. '
  1058. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  1059. ' *  LOCK USER FILE (ORCHID PC-NET)
  1060. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1061. '
  1062. '
  1063. 22300 GOSUB 28100
  1064.       CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1065.       RETURN
  1066. '
  1067. '
  1068. ' *  LOCK SYSTEM (DESQview)
  1069. '
  1070. '
  1071. 22400 CALL DVLock("MESSAGE")
  1072.       RETURN
  1073. '
  1074. '
  1075. ' *  LOCK MESSAGE FILE (10 NET)
  1076. ' *  LOCK USER FILE (10 NET)
  1077. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1078. '
  1079. '
  1080. 22500 GOSUB 28100
  1081.       CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA)
  1082.       RETURN
  1083. '
  1084. '
  1085. ' *  UNLOCK MESSAGE FILE
  1086. '
  1087. '
  1088. 25000 IF NOT ZMsgFileLock THEN _
  1089.          RETURN
  1090.       ZMsgFileLock = ZFalse
  1091.       MID$(ZLockStatus$,1,2) = "UM"
  1092.       ZSubParm = 2
  1093.       CALL Line25
  1094.       ZLockFileName$ = ZActiveMessageFile$
  1095.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  1096.       RETURN
  1097. '
  1098. '
  1099. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1100. '
  1101. '
  1102. 25100 WasAX = &H100
  1103.       WasBX = &H1
  1104.       IF ZMultiLinkPresent > 0 THEN _
  1105.          CALL RBBSML(WasAX,WasBX)
  1106.       RETURN
  1107. '
  1108. '
  1109. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1110. '
  1111. '
  1112. 25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1113.       WasCC$ = CHR$(17) + _
  1114.             LEFT$(Prefix$ + SPACE$(8),8)
  1115.       GOSUB 28000
  1116.       IF WasCT = 128 THEN _
  1117.          RETURN
  1118.       CALL DelayTime (1)
  1119.       GOTO 25200
  1120. '
  1121. '
  1122. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1123. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1124. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1125. '
  1126. '
  1127. 25300 GOSUB 28100
  1128.       CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1129.       RETURN
  1130. '
  1131. '
  1132. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1133. '
  1134. '
  1135. 25400 CALL DVUnlock("MESSAGE")
  1136.       RETURN
  1137. '
  1138. '
  1139. ' *  UNLOCK MESSAGE FILE (10 NET)
  1140. ' *  UNLOCK USER FILE (10 NET)
  1141. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1142. '
  1143. '
  1144. 25500 GOSUB 28100
  1145.       CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA)
  1146.       RETURN
  1147.  
  1148. '
  1149. '
  1150. ' *  LOCK USER FILE
  1151. '
  1152. '
  1153. 26000 IF ZUserFileLock = ZTrue THEN _
  1154.          RETURN
  1155.       ZUserFileLock = ZTrue
  1156.       MID$(ZLockStatus$,4,2) = "LU"
  1157.       ZSubParm = 2
  1158.       CALL Line25
  1159.       ZLockFileName$ = ZActiveUserFile$
  1160.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  1161.       RETURN
  1162. '
  1163. '
  1164. ' *  LOCK USER FILE (MULTI-LINK)
  1165. '
  1166. '
  1167. 26100 WasAX = &H0
  1168.       WasBX = &H2
  1169.       IF ZMultiLinkPresent > 0 THEN _
  1170.          CALL RBBSML(WasAX,WasBX)
  1171.       RETURN
  1172. '
  1173. '
  1174. ' *  LOCK USER FILE (OMNINET)
  1175. '
  1176. '
  1177. 26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1178.       WasCC$ = CHR$(1) + _
  1179.             LEFT$(Prefix$ + SPACE$(8),8)
  1180.       GOSUB 28000
  1181.       IF WasCT = 0 THEN _
  1182.          RETURN
  1183.       CALL DelayTime (1)
  1184.       GOTO 26200
  1185. '
  1186. '
  1187. ' *  LOCK USER FILE (DESQVIEW)
  1188. '
  1189. '
  1190. 26300 CALL DVLock("USER")
  1191.       RETURN
  1192. '
  1193. '
  1194. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1195. '
  1196. '
  1197. 26500 IF ZUserBlockLock = ZTrue THEN _
  1198.          RETURN
  1199.       ZUserBlockLock = ZTrue
  1200.       ZBlk = (ZUserFileIndex / 4) + .26
  1201.       MID$(ZLockStatus$,7,2) = "LB"
  1202.       ZSubParm = 2
  1203.       CALL Line25
  1204.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  1205.       RETURN
  1206. '
  1207. '
  1208. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1209. '
  1210. '
  1211. 26600 WasAX = &H0
  1212.       WasBX = ZBlk + 10
  1213.       IF ZMultiLinkPresent > 0 THEN _
  1214.          CALL RBBSML(WasAX,WasBX)
  1215.       RETURN
  1216. '
  1217. '
  1218. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1219. '
  1220. '
  1221. 26700 WasCC$ = CHR$(1) + _
  1222.             "BLK" + _
  1223.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1224.       GOSUB 28000
  1225.       IF WasCT = 0 THEN _
  1226.          RETURN
  1227.       CALL DelayTime (1)
  1228.       GOTO 26700
  1229. '
  1230. '
  1231. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1232. '
  1233. '
  1234. 26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1235.       RETURN
  1236. '
  1237. '
  1238. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1239. '
  1240. '
  1241. 26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1242.                         "BLK" + _
  1243.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1244.       GOTO 22300
  1245. '
  1246. '
  1247. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1248. '
  1249. '
  1250. 26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1251.                         "BLK" + _
  1252.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1253.       GOTO 22500
  1254. '
  1255. '
  1256. ' *  UNLOCK USER FILE
  1257. '
  1258. '
  1259. 27000 IF NOT ZUserFileLock THEN _
  1260.          RETURN
  1261.       ZUserFileLock = ZFalse
  1262.       MID$(ZLockStatus$,4,2) = "UU"
  1263.       ZSubParm = 2
  1264.       CALL Line25
  1265.       ZLockFileName$ = ZActiveUserFile$
  1266.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  1267.       RETURN
  1268. '
  1269. '
  1270. ' *  UNLOCK USER FILE (MULTI-LINK)
  1271. '
  1272. '
  1273. 27100 WasAX = &H100
  1274.       WasBX = &H2
  1275.       IF ZMultiLinkPresent > 0 THEN _
  1276.          CALL RBBSML(WasAX,WasBX)
  1277.       RETURN
  1278. '
  1279. '
  1280. ' *  UNLOCK USER FILE (OMNINET)
  1281. '
  1282. '
  1283. 27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1284.       WasCC$ = CHR$(17) + _
  1285.             LEFT$(Prefix$ + SPACE$(8),8)
  1286.       GOSUB 28000
  1287.       IF WasCT = 128 THEN _
  1288.          RETURN
  1289.       CALL DelayTime (1)
  1290.       GOTO 27200
  1291. '
  1292. '
  1293. ' *  UNLOCK USER FILE (DESQVIEW)
  1294. '
  1295. '
  1296. 27300 CALL DVUnlock("USER")
  1297.       RETURN
  1298. '
  1299. '
  1300. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1301. '
  1302. '
  1303. 27500 IF NOT ZUserBlockLock THEN _
  1304.          RETURN
  1305.       ZUserBlockLock = ZFalse
  1306.       ZBlk = (ZUserFileIndex / 4) + .26
  1307.       MID$(ZLockStatus$,7,2) = "UB"
  1308.       ZSubParm = 2
  1309.       CALL Line25
  1310.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  1311.       RETURN
  1312. '
  1313. '
  1314. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1315. '
  1316. '
  1317. 27600 WasAX = &H100
  1318.       WasBX = ZBlk + 10
  1319.       IF ZMultiLinkPresent > 0 THEN _
  1320.          CALL RBBSML(WasAX,WasBX)
  1321.       RETURN
  1322. '
  1323. '
  1324. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1325. '
  1326. '
  1327. 27700 WasCC$ = CHR$(17) + _
  1328.             "BLK" + _
  1329.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1330.       GOSUB 28000
  1331.       IF WasCT = 128 THEN _
  1332.          RETURN
  1333.       CALL DelayTime (1)
  1334.       GOTO 27700
  1335. '
  1336. '
  1337. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1338. '
  1339. '
  1340. 27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1341.       RETURN
  1342. '
  1343. '
  1344. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1345. '
  1346. '
  1347. 27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1348.                         "BLK" + _
  1349.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1350.       GOTO 25300
  1351. '
  1352. '
  1353. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1354. '
  1355. '
  1356. 27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1357.                         "BLK" + _
  1358.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1359.       GOTO 25500
  1360. '
  1361. '
  1362. ' *  CORVUS OMNINET INTERFACE
  1363. '
  1364. '
  1365. 28000 WasCC$ = ZLineFeed$ + _
  1366.             CHR$(0) + _
  1367.             CHR$(11) + _
  1368.             WasCC$
  1369.       CALL CDSend(WasCC$)
  1370.       CALL CDRecv(ZWasCN$)
  1371.       WasCT = ASC(MID$(ZWasCN$,3,1))
  1372.       IF WasCT => 128 THEN _
  1373.          CALL LPrnt("CORVUS LOCK FAIL",1) : _
  1374.          ZSubParm = -1
  1375. 28010 WasCT = ASC(MID$(ZWasCN$,4,1))
  1376.       IF WasCT => 129 THEN _
  1377.          CALL LPrnt("CORVUS FULL",1) : _
  1378.          ZSubParm = -1
  1379.       RETURN
  1380. '
  1381. '
  1382. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1383. '
  1384. '
  1385. 28100 CALL AllCaps (ZLockFileName$)
  1386.       ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A")
  1387.       ZLockFileName$ = ZLockFileName$ + _
  1388.                         STRING$(32 - LEN(ZLockFileName$),0)
  1389.       ZWasA = 0
  1390.       RETURN
  1391. '
  1392. '
  1393. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1394. '
  1395. '
  1396. 29000 IF LockedEn$ = ZWasEN$ THEN _
  1397.          RETURN
  1398.       LockedEn$ = ZWasEN$
  1399.       MID$(ZLockStatus$,10,2) = "LD"
  1400.       ZSubParm = 2
  1401.       CALL Line25
  1402.       ZLockFileName$ = ZWasEN$
  1403.       ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710
  1404. 29010 RETURN
  1405. '
  1406. '
  1407. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1408. '
  1409. '
  1410. 29100 WasAX = &H0
  1411.       WasBX = &H3
  1412.       IF ZMultiLinkPresent > 0 THEN _
  1413.          CALL RBBSML(WasAX,WasBX)
  1414.       RETURN
  1415. '
  1416. '
  1417. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1418. '
  1419. '
  1420. 29300 CALL DVLock("MISC")
  1421.       RETURN
  1422. '
  1423. '
  1424. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1425. '
  1426. '
  1427. 29500 IF LockedEn$ <> ZWasEN$ THEN _
  1428.          RETURN
  1429.       LockedEn$ = ""
  1430.       MID$(ZLockStatus$,10,2) = "UD"
  1431.       ZSubParm = 2
  1432.       CALL Line25
  1433.       ZLockFileName$ = ZWasEN$
  1434.       ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810
  1435. 29510 RETURN
  1436. '
  1437. '
  1438. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1439. '
  1440. '
  1441. 29600 WasAX = &H100
  1442.       WasBX = &H3
  1443.       IF ZMultiLinkPresent > 0 THEN _
  1444.          CALL RBBSML(WasAX,WasBX)
  1445.       EXIT SUB
  1446. '
  1447. '
  1448. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1449. '
  1450. '
  1451. 29650 CALL DVUnlock("MISC")
  1452.       RETURN
  1453. '
  1454. '
  1455. ' *  NetBIOS SEMAPHORE LOCK MECHANISM
  1456. ' *     Only the USERS file is actually locked.  All other files are locked
  1457. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1458. ' *     file semaphore as follows:
  1459. ' *        RECORD 1 = MESSAGES file lock status
  1460. ' *        RECORD 2 = Comments/Upload dir locked
  1461. ' *        RECORD 3 = entire USERS file lock
  1462. '
  1463. '
  1464. ' * Lock MESSAGES
  1465. 29700 CALL NetBIOS (1,6,1)
  1466.       RETURN
  1467.  
  1468. ' * Lock Comments/Upload dir
  1469. 29710 CALL NetBIOS (1,6,2)
  1470.       RETURN
  1471.  
  1472. ' * Lock USERS file
  1473. 29720 CALL NetBIOS (1,6,3)
  1474.       RETURN
  1475.  
  1476. ' * Lock single USERS record
  1477. 29730 CALL NetBIOS (1,6,3)
  1478.       RETURN
  1479.  
  1480. ' * UNLOCK MESSAGES
  1481. 29800 CALL NetBIOS (0,6,1)
  1482.       RETURN
  1483.  
  1484. ' * UNLOCK Comments/Upload dir
  1485. 29810 CALL NetBIOS (0,6,2)
  1486.       RETURN
  1487.  
  1488. ' * UNLOCK USERS file
  1489. 29820 CALL NetBIOS (0,6,3)
  1490.       RETURN
  1491.  
  1492. ' * UNLOCK single USERS record
  1493. 29830 CALL NetBIOS (0,6,3)
  1494.       RETURN
  1495.       END SUB
  1496. 30000 ' $SUBTITLE: 'InitIBM - sub to create/open NetBIOS semaphore file'
  1497. ' $PAGE
  1498. '
  1499. '  NAME    -- InitIBM   (Written by Doug Azzarito)
  1500. '
  1501. '  INPUTS  -- NONE
  1502. '
  1503. '  OUTPUTS -- ZSubParm = -1   Abort RBBS
  1504. '
  1505. '  PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
  1506. '             Create file if it does not exits.
  1507. '
  1508.       SUB InitIBM STATIC
  1509. '
  1510. '
  1511. ' *  SEE IF FILE EXISTS
  1512. '
  1513. '
  1514.       ZShareIt = ZTrue
  1515.       CALL BreakFileName (ZMainMsgFile$,IBMFlagFile$,Dummy$,Dummy$,ZTrue)
  1516.       IBMFlagFile$ = IBMFlagFile$ + _
  1517.                        "IBMFLAGS"
  1518.       CALL FindIt (IBMFlagFile$)
  1519.       CLOSE 2
  1520.       IF ZOK THEN _
  1521.          GOTO 30020
  1522. '
  1523. '
  1524. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
  1525. '
  1526. '
  1527.       OPEN IBMFlagFile$ ACCESS WRITE AS #6 LEN=2
  1528.       FIELD 6, 2 AS LockBuf$
  1529.       LSET LockBuf$ = MKI$(0)
  1530.       FOR WasI = 1 TO 3
  1531.          PUT 6
  1532.       NEXT
  1533.       CLOSE #6
  1534. 30020 OPEN IBMFlagFile$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1535.       END SUB
  1536. 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
  1537. ' $PAGE
  1538. '
  1539. '  NAME    -- OpenMsg
  1540. '
  1541. '  INPUTS  --     PARAMETER                    MEANING
  1542. '              ZActiveMessageFile$
  1543. '              ZShareIt
  1544. '
  1545. '  OUTPUTS --  ZMsgRec$
  1546. '
  1547.       SUB OpenMsg STATIC
  1548. '
  1549. '
  1550. ' *  OPEN AND DEFINE MESSAGE FILE
  1551. '
  1552. '
  1553.      CLOSE 1
  1554.       IF ZShareIt THEN _
  1555.          OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
  1556.       ELSE OPEN "R",1,ZActiveMessageFile$
  1557.       FIELD 1,128 AS ZMsgRec$
  1558.       END SUB
  1559. 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
  1560. ' $PAGE
  1561. '
  1562. '  NAME    -- FindFKey
  1563. '
  1564. '  INPUTS  --  PARAMETER                 MEANING
  1565. '             ZActiveMenu$              INDICATOR OF ACTIVE MENU
  1566. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1567. '             ZAutoDownDesired          USER'S PREFERENCE FOR AUTODOWNLOADING
  1568. '             ZCallersFile$             NAME OF CALLERS FILE
  1569. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1570. '             ZCheckBulletLogon         USER'S PREFERENCE FOR BULLETIN CHECK
  1571. '             ZConfMode                 INDICATOR THAT USER IS IN A CONFERENCE
  1572. '             ZCursorLine               LINE THAT THE CURSOR IS AT
  1573. '             ZCursorRow                ROW THAT THE CURSOR IS AT
  1574. '             ZDiskForDos$              DISK TO LOAD COMMAND.COM FROM
  1575. '             ZDiskFullGoOffline        INDICATOR OF WHAT TO DO WHEN DISK FULL
  1576. '             ZExitToDoors              FLAG INDICATING EXITING TO DOORS
  1577. '             ZExpertUser               FLAG FOR EXPERT/NOVICE USER MODE
  1578. '             ZFirstName$               LOGGED ON USER'S First NAME
  1579. '             ZF1Key                    FUNCTION KEY ONE VALUE
  1580. '             ZF10Key                   FUNCTION KEY TEN VALUE
  1581. '             ZWasGR                    GRAPHICS PREFERENCE OF USER
  1582. '             ZLineFeeds                SWTICH FOR USER'S LINE FEED PREFERENCE
  1583. '             ZLocalUser                FLAG INDICATING USER IS LOCAL
  1584. '             ZMinLogonSec              MINIMUM SECURITY TO LOGON
  1585. '             ZModemGoOffHookCmd$       COMMAND TO TAKE MODEM OFF-HOOK
  1586. '             ZModemInitBaud$           BAUD TO INITIALIZE MODEM AT
  1587. '             ZNodeID$                  NODE IDENTIFIER
  1588. '             ZNodeRecIndex             NODE RECORD Index FOR THIS NODE
  1589. '             ZNulls                    Switch FOR USER'S PREFERENCE FOR Nulls
  1590. '             ZPrinter                  Toggle INDICATING Printer IS AVAILABLE
  1591. '             ZPromptBell               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1592. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION
  1593. '             ZSkipFilesLogon           USER'S LOGON NOTIFICIATION PREFERENCE
  1594. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1595. '             ZSubParm                  -8  = Sysop'S OPTION 6 REMOTELY
  1596. '                                       -9  = GOT TO DOS
  1597. '                                       -10 = Sysop GET'S SYSTEM NEXT
  1598. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1599. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1600. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1601. '             ZUpperCase                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1602. '             ZUserFileIndex            Index INTO THE USER FILE FOR CALLER
  1603. '             ZUserSecLevel             USER'S SECURITY LEVEL
  1604. '             USERT.TRANSFER.DEFAULT    USER'S FILE Transfer DEFAULT PREFERENCE
  1605. '
  1606. '  OUTPUTS --
  1607. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1608. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1609. '             ZFunctionKey              VALUE 1 TO 10 CORRESPONDING TO
  1610. '                                       THE FUNCTION KEY THAT WAS PRESSED
  1611. '             ZKeyPressed$              CHARACTER STRING GENERATED BY KEY
  1612. '             ZPrinter                  TOGGLE INDICATING Printer IS AVAILABLE
  1613. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1614. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1615. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1616. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1617. '             ZSubParm                  -1 Carrier LOST
  1618. '                                       -2 CHAT MODE ACTIVATED
  1619. '                                       -3 FORCE CALLER ON-LINE
  1620. '                                       -4 EXIT TO SYSTEM IMMEDIATELY
  1621. '                                       -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1622. '                                       -6 TELL USER ACCESS IS DENIED
  1623. '                                       -7 UPDATE CALLERS FILE AND DENY ACCESS
  1624. '             ZUserSecLevel      USER'S SECURITY LEVEL
  1625. '
  1626. '  PURPOSE -- To determine if a function has been pressed on
  1627. '             the PC'S keyboard that is running RBBS-PC.
  1628. '
  1629.       SUB FindFKey STATIC
  1630.       LookUp = ZSubParm
  1631.       IF ZSubParm < -1 THEN _
  1632.          ZSubParm = 0 : _
  1633.          IF LookUp = - 8 THEN _
  1634.             GOTO 33070 _
  1635.          ELSE IF LookUp = - 9 THEN _
  1636.                  GOTO 31000 _
  1637.               ELSE IF LookUp = - 10 THEN _
  1638.                       GOTO 33090
  1639. '
  1640. '
  1641. ' *  TEST FOR FUNCTION KEY PRESSED
  1642. '
  1643. '
  1644. 30600 IF ZKeyboardStack$ = "" THEN _
  1645.          ZKeyPressed$ = INKEY$ _
  1646.       ELSE ZKeyPressed$ = ZKeyboardStack$ : _
  1647.            ZKeyboardStack$ = ""
  1648.       ZFunctionKey = 0
  1649.       IF LEN(ZKeyPressed$) <> 2 THEN _
  1650.          GOTO 33970
  1651.       ZKeyPressed = ASC(RIGHT$(ZKeyPressed$,1))
  1652.       IF ZLocalUser AND NOT ZSysop THEN _
  1653.          ZKeyPressed$ = "" : _
  1654.          GOTO 33970
  1655.       IF ZKeyPressed => ZF1Key AND _
  1656.          ZKeyPressed <= ZF10Key THEN _
  1657.              ZFunctionKey = ZKeyPressed - 58 : _
  1658.              GOTO 30610
  1659.       IF ZKeyPressed = 117 THEN _    'Ctrl-End
  1660.          ZFunctionKey = 11
  1661.       IF ZKeyPressed = 73 THEN _     'PgUp
  1662.          ZFunctionKey = 12
  1663.       IF ZKeyPressed = 72 THEN _     'up arrow
  1664.          ZFunctionKey = 13
  1665.       IF ZKeyPressed = 80 THEN _     'Down arrow
  1666.          ZFunctionKey = 14
  1667.       IF ZKeyPressed = 81 THEN _     'PgDn
  1668.          ZFunctionKey = 15
  1669.       IF ZKeyPressed = 75 THEN _     'left arrow
  1670.          ZFunctionKey = 16
  1671.       IF ZKeyPressed = 77 THEN _     'Right arrow
  1672.          ZFunctionKey = 17
  1673.       IF ZKeyPressed = 141 THEN _    'CTRL-up arrow
  1674.          ZFunctionKey = 18
  1675.       IF ZKeyPressed = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1676.          ZFunctionKey = 18
  1677.       IF ZKeyPressed = 145 THEN _    'CTRL-down arrow
  1678.          ZFunctionKey = 19
  1679.       IF ZKeyPressed = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1680.          ZFunctionKey = 19
  1681.       IF ZKeyPressed = 115 THEN _    'CTRL-left arrow
  1682.          ZFunctionKey = 20
  1683.       IF ZKeyPressed = 116 THEN _    'CTRL-right arrow
  1684.          ZFunctionKey = 21
  1685.       IF ZKeyPressed = 79 THEN _     'End (a nice way to kick user off)
  1686.          ZFunctionKey = 22
  1687. 30610 ZKeyPressed$ = ""
  1688.       IF ZFunctionKey < 1 OR ZFunctionKey > 22 THEN _
  1689.          GOTO 33970
  1690.       IF ZFunctionKey < 10 AND (ZFunctionKey <> 8) THEN _
  1691.          GOTO 30620
  1692.       IF ZToggleOnly THEN _
  1693.          ZSubParm = 1 : _
  1694.          GOTO 33970
  1695. 30620 ON ZFunctionKey GOTO  31000, _            '  1 =  F1
  1696.                             32000, _            '  2 =  F2
  1697.                             33000, _            '  3 =  F3
  1698.                             33040, _            '  4 =  F4
  1699.                             33060, _            '  5 =  F5
  1700.                             33070, _            '  6 =  F6
  1701.                             33090, _            '  7 =  F7
  1702.                             33110, _            '  8 =  F8
  1703.                             33130, _            '  9 =  F9
  1704.                             33150, _            ' 10 = F10
  1705.                             31398, _            ' 11 = CTRL END
  1706.                             33200, _            ' 12 = PGUP
  1707.                             33170, _            ' 13 = UP ARROW
  1708.                             33180, _            ' 14 = DOWN ARROW
  1709.                             33220, _            ' 15 = PGDN
  1710.                             33240, _            ' 16 = LEFT ARROW
  1711.                             33250, _            ' 17 = RIGHT ARROW
  1712.                             33170, _            ' 18 = CTRL-UP ARROW
  1713.                             33180, _            ' 19 = CTRL-DOWN
  1714.                             33245, _            ' 20 = CTRL-LEFT
  1715.                             33255, _            ' 21 = CTRL-RIGHT
  1716.                             31398               ' 22 = END
  1717. '
  1718. '
  1719. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
  1720. '
  1721. '
  1722. 31000 ZSubParm = -10
  1723.       CALL Carrier
  1724.       IF ZSubParm = 0 THEN _
  1725.          GOTO 33970
  1726.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "F1.DEF"
  1727.       CLOSE 2
  1728.       CALL OpenOutW (ZFileName$)
  1729.       PRINT #2,MID$(ZFileName$,3,7)
  1730.       IF ZExitToDoors THEN _
  1731.          ZSubParm = -4 : _
  1732.          GOTO 33970
  1733.       CALL OpenCom(ZModemInitBaud$,",N,8,1")
  1734.       CALL TakeOffHook
  1735.       ZSubParm = -5
  1736.       GOTO 33970
  1737. '
  1738. '
  1739. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
  1740. '
  1741. '
  1742. 31398 IF NOT ZLocalUser THEN _
  1743.          CALL Carrier : _
  1744.          IF ZSubParm = -1 THEN _
  1745.             GOTO 33970
  1746.       IF INSTR("MUF",ZActiveMenu$) > 0 THEN _
  1747.          GOTO 31399
  1748.       ZCursorLine = CSRLIN
  1749.       ZCursorRow = POS(0)
  1750.       LOCATE 25,1
  1751.       WasD$ = SPACE$(79)
  1752.       GOSUB 33210
  1753.       LOCATE 25,1
  1754.       WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1755.       GOSUB 33210
  1756.       CALL DelayTime (1)
  1757.       LOCATE ZCursorLine,ZCursorRow
  1758.       ZSubParm = 1
  1759.       CALL Line25
  1760.       GOTO 33970
  1761. 31399 IF ZFunctionKey = 22 THEN _
  1762.          CALL SkipLine (2) : _
  1763.          CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SysOp needs the system") : _
  1764.          CALL DelayTime (8 + ZBPS) : _
  1765.          ZSubParm = -6 : _
  1766.          GOTO 33970
  1767.       CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back")
  1768.       CALL DelayTime (8 + ZBPS) : _
  1769.       IF ZUserFileIndex < 1 THEN _
  1770.          ZSubParm = -6 : _
  1771.          GOTO 33970
  1772.       ZUserSecLevel = ZMinLogonSec - 1
  1773.       CALL DenyAccess
  1774.       ZSubParm = -7
  1775.       GOTO 33970
  1776. '
  1777. '
  1778. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1779. '
  1780. '
  1781.  
  1782. 32000 IF NOT ZLocalUser THEN _
  1783.          CALL SkipLine (1) : _
  1784.          CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _
  1785.          ZFunctionKey = 0 : _
  1786.          CALL DelayTime (3)
  1787.       CALL ShellExit (ZDiskForDos$ + "COMMAND")
  1788.       'SHELL ZDiskForDos$ + _
  1789.       '      "COMMAND"
  1790.       CLS
  1791.       IF NOT ZLocalUser THEN _
  1792.          CALL Carrier : _
  1793.          IF ZSubParm = -1 THEN _
  1794.             GOTO 33970
  1795.       ZSubParm = 2
  1796.       CALL Line25
  1797.       CALL QuickTPut1 ("Sysop back from DOS.  Returning control to you.")
  1798.       ZCommPortStack$ = ZCarriageReturn$
  1799.       GOTO 33970
  1800. '
  1801. '
  1802. ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
  1803. '
  1804. '
  1805. 33000 ZPrinter = NOT ZPrinter
  1806.       ChangeValue = ZPrinter
  1807.       FieldPosition = 38
  1808.       GOTO 33950
  1809. '
  1810. '
  1811. ' * F4 - COMMAND FROM LOCAL KEYBOARD (Sysop ANNOY)
  1812. '
  1813. '
  1814. 33040 ZSysopAnnoy = NOT ZSysopAnnoy
  1815.       ChangeValue = ZSysopAnnoy
  1816.       FieldPosition = 34
  1817.       GOTO 33950
  1818. '
  1819. '
  1820. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
  1821. '
  1822. '
  1823. 33060 ZFunctionKey = 0
  1824.       ZSubParm = -3
  1825.       GOTO 33970
  1826. '
  1827. '
  1828. ' * F6 - COMMAND FROM LOCAL KEYBOARD (Sysop AVAILABLE Toggle)
  1829. ' *  6 - COMMAND FROM Sysop MENU (Sysop AVAILABLE Toggle)
  1830. '
  1831. '
  1832. 33070 ZSysopAvail = NOT ZSysopAvail
  1833.       ChangeValue = ZSysopAvail
  1834.       FieldPosition = 32
  1835.       GOTO 33950
  1836. '
  1837. '
  1838. ' * F7 - COMMAND FROM LOCAL KEYBOARD (Sysop GETS SYSTEM NEXT)
  1839. '
  1840. '
  1841. 33090 IF ERR=61 AND NOT ZDiskFullGoOffline THEN _
  1842.          GOTO 33970
  1843.       ZSysopNext = NOT ZSysopNext
  1844.       ChangeValue = ZSysopNext
  1845.       FieldPosition = 36
  1846.       GOTO 33950
  1847. '
  1848. '
  1849. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY Sysop SECURITY)
  1850. '
  1851. '
  1852. 33110 ZSysop = NOT ZSysop
  1853.       ZCursorLine = CSRLIN
  1854.       ZCursorRow = POS(0)
  1855.       LOCATE 25,1
  1856.       WasD$ = SPACE$(79)
  1857.       NumReturns = 0
  1858.       CALL LPrnt (WasD$,NumReturns)
  1859.       LOCATE 25,1
  1860.       ZUserSecLevel = (1 + ZSysop) * _
  1861.                             ZUserSecSave  - _
  1862.                             ZSysop * _
  1863.                             ZSysopSecLevel
  1864.       WasD$ = "Sysop Privileges " + FNOffOn$(ZSysop)
  1865.       CALL LPrnt (WasD$,NumReturns)
  1866.       CALL DelayTime (3)
  1867.       LOCATE ZCursorLine,ZCursorRow
  1868.       ZSubParm = 1
  1869.       CALL Line25
  1870.       CALL SetPrompt
  1871.       GOTO 33970
  1872. '
  1873. '
  1874. ' * F9 - COMMAND FROM LOCAL KEYBOARD (Snoop Toggle)
  1875. '
  1876. '
  1877. 33130 IF NOT ZSnoop THEN _
  1878.          ZSnoop = ZTrue : _
  1879.          LOCATE 24,1,0 : _
  1880.          WasD$ = "SNOOP ON" : _
  1881.          NumReturns = 0 : _
  1882.          CALL LPrnt (WasD$,NumReturns) : _
  1883.          ZSubParm = 2 : _
  1884.          CALL Line25 _
  1885.       ELSE LOCATE ,,0 : _
  1886.            ZSnoop = ZFalse : _
  1887.            CLS
  1888. 33140 ChangeValue = ZSnoop
  1889.       FieldPosition = 58
  1890.       GOTO 33950
  1891. '
  1892. '
  1893. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
  1894. '
  1895. '
  1896. 33150 GOTO 33160
  1897. 33155 ZSubParm = 1
  1898.       CALL Line25
  1899.       GOTO 33970
  1900. 33160 CALL UpdtCalr ("Sysop began chat",1)
  1901.       ZPageStatus$ = ""
  1902.       CALL SkipLine (1)
  1903.       CALL QuickTPut1 ("Hi " + _
  1904.            ZFirstName$ + _
  1905.            ", this is " + _
  1906.            ZSysopFirstName$ + _
  1907.            " " + _
  1908.            ZSysopLastName$ + _
  1909.            "  Sorry to break in to CHAT but..")
  1910.       CALL TimeBack (1)
  1911.       CALL SysopChat
  1912.       CALL TimeBack (2)
  1913.       ZCommPortStack$ = CHR$(13)
  1914.       GOTO 33155
  1915. '
  1916. '
  1917. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1918. '
  1919. '
  1920. 33170 ZUserSecLevel = ZUserSecLevel + _
  1921.                             1 - 4 * (ZFunctionKey = 18)
  1922.       GOTO 33190
  1923. '
  1924. '
  1925. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1926. '
  1927. '
  1928. 33180 ZUserSecLevel = ZUserSecLevel - _
  1929.                             1 + 4 * (ZFunctionKey = 19)
  1930. 33190 ZAdjustedSecurity = ZTrue
  1931.       ZUserSecSave = ZUserSecLevel
  1932.       IF (NOT ZConfMode) AND (NOT ZSubBoard) THEN _
  1933.          ZOrigSec = ZUserSecLevel : _
  1934.       ZSubParm = 2
  1935.       CALL Line25
  1936.       CALL SetPrompt
  1937.       GOTO 33970
  1938. '
  1939. '
  1940. ' * PGUP DISPLAY USER PROFILE
  1941. '
  1942. '
  1943. 33200 IF NOT ZLocalUser THEN _
  1944.          CALL Carrier : _
  1945.          IF ZSubParm = -1 THEN _
  1946.             GOTO 33970
  1947.       IF ZVoiceType <> 0 THEN _
  1948.          ZTalkAll = ZTrue
  1949.       CALL PageUp
  1950.       WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
  1951.       GOSUB 33210
  1952.       WasD$ = "GRAPHICS: " + _
  1953.            MID$("None AsciiColor",ZWasGR * 5 + 1,5)
  1954.       GOSUB 33210
  1955.       WasD$ = "Protocol : " + _
  1956.            ZUserXferDefault$
  1957.       GOSUB 33210
  1958.       WasD$ = "UPPER CASE " + _
  1959.            MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
  1960.       GOSUB 33210
  1961.       WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
  1962.       GOSUB 33210
  1963.       WasD$ = "Nulls " + FNOffOn$(ZNulls)
  1964.       GOSUB 33210
  1965.       WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  1966.       GOSUB 33210
  1967.       WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  1968.            " old BULLETINS on logon."
  1969.       GOSUB 33210
  1970.       WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
  1971.            " new files on logon."
  1972.       GOSUB 33210
  1973.       WasD$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  1974.       GOSUB 33210
  1975.       ZTalkAll = ZFalse
  1976.       GOTO 33970
  1977. 33210 NumReturns = 1
  1978.       CALL LPrnt(WasD$,NumReturns)
  1979.       RETURN
  1980. '
  1981. '
  1982. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE
  1983. '
  1984. '
  1985. 33220 IF NOT ZLocalUser THEN _
  1986.          CALL Carrier : _
  1987.          IF ZSubParm = -1 THEN _
  1988.             GOTO 33970
  1989.       CLS
  1990.       GOTO 33155
  1991. '
  1992. '
  1993. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1994. '
  1995. '
  1996. 33240 IF ZSecsPerSession! > 120 THEN _
  1997.          ZSecsPerSession! = ZSecsPerSession! - 60
  1998.       GOTO 33970
  1999. '
  2000. '
  2001. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  2002. '
  2003. '
  2004. 33245 IF ZSecsPerSession! > 360 THEN _
  2005.          ZSecsPerSession! = ZSecsPerSession! - 300
  2006.       GOTO 33970
  2007. '
  2008. '
  2009. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  2010. '
  2011. '
  2012. 33250 IF ZSecsPerSession! < 86280 THEN _
  2013.          ZSecsPerSession! = ZSecsPerSession! + 60
  2014.       ZTimeLockSet = 0
  2015.       GOTO 33970
  2016. '
  2017. '
  2018. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  2019. '
  2020. '
  2021. 33255 IF ZSecsPerSession! < 86040 THEN _
  2022.          ZSecsPerSession! = ZSecsPerSession! + 300
  2023.       ZTimeLockSet = 0
  2024.       GOTO 33970
  2025. '
  2026. '
  2027. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
  2028. '
  2029. '
  2030. 33950 IF ZSnoop THEN _
  2031.          ZSubParm = 1 : _
  2032.          CALL Line25
  2033. 33960 IF ZConfMode = ZTrue THEN _
  2034.          IF ZLocalUser THEN _
  2035.             GOTO 33970 _
  2036.          ELSE WasD$ = "Cannot change status during Conference!" : _
  2037.               GOSUB 33210 : _
  2038.               GOTO 33970
  2039.       ZSubParm = 3
  2040.       CALL FileLock
  2041.       IF ZSubParm = -1 THEN _
  2042.          GOTO 33970
  2043.       CALL OpenMsg
  2044.       FIELD 1,128 AS ZMsgRec$
  2045.       GET 1,ZNodeRecIndex
  2046.       MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue)
  2047.       CALL SaveProf (2)
  2048.       FIELD 1, 128 AS ZMsgRec$
  2049. 33970 END SUB
  2050. 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
  2051. ' $PAGE
  2052. '
  2053. '  NAME    -- PageUp
  2054. '
  2055. '  INPUTS  --     PARAMETER                    MEANING
  2056. '                 ZActiveUserName$       CURRENT USER NAME
  2057. '                 ZDnlds                 # OF FILES DOWNLOADED
  2058. '                 ZExpirationDate$       REGISTRATION EXPIRATION
  2059. '                 ZLastDateTimeOnSave$   Last DATE & TIME ON SYSTEM
  2060. '                 ZLastMsgRead           Last MESSAGE READ BY USER
  2061. '                 ZPswdSave$             USERS PASSWORD
  2062. '                 ZTimesLoggedOn         TIMES USER HAS LOGGED ON
  2063. '                 ZUplds                 # OF FILES UPLOADED
  2064. '                 ZUserSecSave           USERS SECURITY LEVEL
  2065. '
  2066. '  OUTPUTS -- ZMsgRec$
  2067. '
  2068.       SUB PageUp STATIC
  2069.       CALL LPrnt (" ",1)
  2070.       CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
  2071.       CALL LPrnt ("SECURITY  :" + STR$(ZUserSecSave),1)
  2072.       CALL LPrnt ("PASSWORD  :" + ZPswdSave$,1)
  2073.       CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
  2074.       CALL LPrnt ("TIMES ON  :" + STR$(ZTimesLoggedOn),1)
  2075.       CALL LPrnt ("LAST ON   :" + ZLastDateTimeOnSave$,1)
  2076.       CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
  2077.       CALL LPrnt ("UPLOADS   :" + STR$(ZUplds),1)
  2078.       IF ZEnforceRatios THEN _
  2079.          CALL LPrnt ("DL-BYTES  :" + STR$(ZDLBytes!),1) : _
  2080.          CALL LPrnt ("UL-BYTES  :" + STR$(ZULBytes!),1)
  2081.       IF ZRestrictByDate THEN _
  2082.          CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
  2083.       CALL LPrnt ("User's Profile",1)
  2084.       END SUB
  2085. 35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input'
  2086. ' $PAGE
  2087. '
  2088. '  NAME    -- FlushKeys
  2089. '
  2090.       SUB FlushKeys STATIC
  2091.       CALL FlushCom (ZWasY$)
  2092.       ZLastIndex = 0
  2093.       REDIM ZUserIn$(ZMsgDim)
  2094.       END SUB
  2095. 41008 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
  2096. ' $PAGE
  2097. '
  2098. '  NAME    -- CheckTimeRemain
  2099. '
  2100. '  INPUTS  -- PARAMETER                 MEANING
  2101. '
  2102. '  OUTPUTS -- PARAMETER                 MEANING
  2103. '             MinsRemaining         TIME IN MINUTES LEFT IN SESSION
  2104. '             ZSecsUsedSession!     TIME USED IN SECONDS
  2105. '             ZSubParm              -1 IF No TIME LEFT
  2106. '
  2107.       SUB CheckTimeRemain (MinsRemaining) STATIC
  2108.       CALL TimeRemain (MinsRemaining)
  2109.       IF ZBypassTimeCheck THEN _
  2110.          EXIT SUB
  2111.       IF MinsRemaining <= 0 THEN _
  2112.          ZSubParm = -1
  2113.       END SUB
  2114. 41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session'
  2115. ' $PAGE
  2116. '
  2117. '  NAME    -- TimeRemain
  2118. '
  2119. '  INPUTS  -- PARAMETER                 MEANING
  2120. '             ZUserLogonTime!          WHEN DID THE CALLER GET HERE
  2121. '             ZSecsPerSession!         HOW LONG MAY THE CALLER STAY ON
  2122. '             ZTimeToDropToDos!        WHEN ARE WE DOING OUR DAILY EVENT
  2123. '             ZBypassTimeCheck         DO WE CARE HOW LONG THEY CAN STAY
  2124. '
  2125. '  OUTPUTS -- PARAMETER                 MEANING
  2126. '             MinsRemaining            TIME IN MINUTES LEFT IN SESSION
  2127. '             ZSecsUsedSession!        TIME USED IN SECONDS
  2128. '
  2129.       SUB TimeRemain (MinsRemaining) STATIC
  2130.       TOA! = FRE("A")
  2131.       IF ZBypassTimeCheck THEN _
  2132.          MinsRemaining = ZSecsPerSession! / 60 : _
  2133.          EXIT SUB
  2134.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  2135.       IF ZTimeToDropToDos! = 0 OR _
  2136.          ZOldDate$ = DATE$ THEN _
  2137.          GOTO 41020
  2138.       CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
  2139.       IF HowMuchTimeLeft! < -60 THEN _
  2140.          HowMuchTimeLeft! = (HowMuchTimeLeft! * -1) + 43200
  2141.       IF (ZSecsPerSession! - ZSecsUsedSession!) > HowMuchTimeLeft! THEN _
  2142.          ZSecsPerSession! = HowMuchTimeLeft! + ZSecsUsedSession! : _
  2143.          IF NOT ToldShort THEN _
  2144.             ToldShort = ZTrue : _
  2145.             ZOutTxt$ = "Shortened session time to" + _
  2146.                 STR$(INT((ZSecsPerSession! - ZSecsUsedSession!) / 60)) + _
  2147.                 " min for scheduled event" : _
  2148.             CALL RingCaller
  2149. 41020 MinsRemaining = INT((ZSecsPerSession! - ZSecsUsedSession!) / 60)
  2150.       END SUB
  2151. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  2152. ' $PAGE
  2153. '
  2154. '  NAME    -- DispTimeRemain
  2155. '
  2156. '  INPUTS  --     PARAMETER                    MEANING
  2157. '              MinsRemaining
  2158. '
  2159. '  OUTPUTS --     PARAMETER                    MEANING
  2160. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  2161. '
  2162.       SUB DispTimeRemain (MinsRemaining) STATIC
  2163.       CALL TimeRemain (MinsRemaining)
  2164.       CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left")
  2165.       END SUB
  2166. 41498 ' $SUBTITLE: 'AMorPM - give time of day in AM/PM format'
  2167. ' $PAGE
  2168. '
  2169. '  NAME    -- AMorPM
  2170. '
  2171. '  INPUTS  --     PARAMETER                    MEANING
  2172. '
  2173. '  OUTPUTS -- ZCurDate$                 CURRENT DATE (MM-DD-YY)
  2174. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  2175. '
  2176. '  PURPOSE -- To set the time and date and
  2177. '             describe the time as "AM" or "PM."
  2178. '
  2179.       SUB AMorPM STATIC
  2180. '
  2181. '
  2182. ' *  CALCULATE CURRENT TIME FOR AM OR PM
  2183. '
  2184. '
  2185. 41500 ZCurDate$ = DATE$
  2186.       ZCurDate$ = LEFT$(ZCurDate$ ,6) + _
  2187.                       RIGHT$(ZCurDate$ ,2)
  2188. 41510 ZTime$ = TIME$
  2189.       IF VAL(MID$(ZTime$,1,2)) = 12 THEN _
  2190.          MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))),2) : _
  2191.          ZTime$ = LEFT$(ZTime$,5) + _
  2192.                 " PM" : _
  2193.          EXIT SUB
  2194.       IF VAL(MID$(ZTime$,1,2)) > 11 THEN _
  2195.          MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))-12),2) : _
  2196.          ZTime$ = LEFT$(ZTime$,5) + _
  2197.                 " PM" : _
  2198.          EXIT SUB
  2199.       ZTime$ = LEFT$(ZTime$,5) + _
  2200.              " AM"
  2201.       END SUB
  2202. 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
  2203. ' $PAGE
  2204. '
  2205. '  NAME    -- Carrier
  2206. '
  2207. '  INPUTS  --     PARAMETER                    MEANING
  2208. '              ZAutoLogoffReq                  -1 if in autologoff request
  2209. '
  2210. '  OUTPUTS --  ZSubParm = 0                    CONTINUE
  2211. '              ZSubParm = -1                   TERMINATE (No Carrier)
  2212. '
  2213. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  2214. '              NOT to continue are:  autologoff, out of time, or
  2215. '              carrier dropped.
  2216. '
  2217.       SUB Carrier STATIC
  2218.       IF ZAutoLogoffReq THEN _
  2219.          IF NOT ZSuspendAutologoff THEN _
  2220.             ZSubParm = -1 : _
  2221.             EXIT SUB
  2222.       CALL CheckCarrier
  2223.       END SUB
  2224. 42005 ' $SUBTITLE: 'CheckCarrier - monitors carrier on comm. port'
  2225. ' $PAGE
  2226. '
  2227. '  NAME    -- CheckCarrier
  2228. '
  2229. '  INPUTS  --     PARAMETER                    MEANING
  2230. '              ZLocalUser = 0               REMOTE USER
  2231. '              ZLocalUser = -1              LOCAL KEYBOARD USER
  2232. '              ZModemStatusReg              ADDRESS OF THE COMMUNI-
  2233. '                                           CATIONS PORT'S REGISTER
  2234. '              ZSubParm = -9                DON'T WRITE TO CALLERS
  2235. '              ZSubParm = -10               SAME AS -9, BUT DON'T
  2236. '                                           DELAY
  2237. '
  2238. '  OUTPUTS --  ZSubParm = 0                 Carrier STILL PRESENT
  2239. '              ZSubParm = -1                Carrier NOT PRESENT
  2240. '
  2241. '  PURPOSE --  To test if carrier is present (i.e. the user
  2242. '              is still on line).  Ignores whether in autologoff.
  2243. '
  2244.       SUB CheckCarrier STATIC
  2245.       IF ZSubParm = -1 THEN _
  2246.          EXIT SUB
  2247.       Speedy = ZSubParm
  2248.       ZSubParm = 0
  2249. '
  2250. '
  2251. ' * TEST FOR Carrier PRESENT (DROP CALLER IF Carrier NOT PRESENT)
  2252. '
  2253. '
  2254.       IF ZLocalUser THEN _
  2255.          EXIT SUB
  2256.       IF ZFossil THEN _
  2257.          CALL FosStatus(ZComPort,Status) : _
  2258.          Status = Status AND &H0080 : _
  2259.          IF Status = &H0080 THEN _
  2260.             EXIT SUB _
  2261.          ELSE GOTO 42015
  2262. 42010 IF INP(ZModemStatusReg) > 127 THEN _
  2263.          EXIT SUB
  2264. '
  2265. '
  2266. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR Carrier
  2267. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE Carrier,
  2268. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
  2269. '
  2270. '
  2271. 42015 IF Speedy = -10 THEN _
  2272.          GOTO 42020
  2273.       CALL DelayTime (ZModemInitWaitTime)
  2274.       IF ZFossil THEN _
  2275.          CALL FosStatus(ZComPort,Status) : _
  2276.          Status = Status AND &H0080 : _
  2277.          IF Status = &H0080 THEN _
  2278.             EXIT SUB _
  2279.          ELSE GOTO 42020
  2280.       IF INP(ZModemStatusReg) > 127 THEN _
  2281.          EXIT SUB
  2282. 42020 ZSubParm = -1
  2283.       IF Speedy < -8 THEN _
  2284.          EXIT SUB
  2285.       IF AlreadyWritten = -9 THEN _
  2286.          EXIT SUB
  2287.       CALL TakeOffHook
  2288.       ZModemOffHook = -1
  2289.       AlreadyWritten = -9
  2290.       CALL UpdtCalr ("Carrier dropped",1)
  2291.       END SUB
  2292. 43004 ' $SUBTITLE: 'AskGraphics -- sub to ask users graphic preference'
  2293. ' $PAGE
  2294. '
  2295. '  NAME    -- AskGraphics
  2296. '
  2297. '  INPUTS  --    PARAMETER                    MEANING
  2298. '                ZUserGraphicDefault$        USER Graphic DEFAULT
  2299. '
  2300. '  OUTPUTS --
  2301. '
  2302. '  PURPOSE --  To determine users graphics default
  2303. '
  2304.       SUB AskGraphics STATIC
  2305.       IF ZExpertUser THEN _
  2306.          GOTO 43007
  2307. 43006 ZFileName$ = ZHelp$(9)
  2308.       CALL BufFile (ZFileName$,WasX)
  2309.       IF ZSubParm = -1 THEN _
  2310.          EXIT SUB
  2311. 43007 CALL QuickTPut1 ("GRAPHICS for text files and menus")
  2312.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  2313.       ZSubParm = 1
  2314.       ZTurboKey = -ZTurboKeyUser
  2315.       CALL TGet
  2316.       IF ZSubParm = -1 THEN _
  2317.          EXIT SUB
  2318.       IF ZWasQ = 0 THEN _
  2319.          CALL QuickTPut1 ("Unchanged") : _
  2320.          EXIT SUB
  2321.       CALL AraAllCaps (ZUserIn$(),1)
  2322.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  2323.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  2324.          CALL QuickTPut1 ("Ascii unavailable.  Requires 8 bit") : _
  2325.          GOTO 43007
  2326.       IF ZWasGR = 0 THEN _
  2327.          GOTO 43006
  2328.       ZWasGR = ZWasGR - 1
  2329.       CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
  2330.       END SUB
  2331. '
  2332. 43031 ' $SUBTITLE: 'GraphicX - sub to find graphic version of a file'
  2333. ' $PAGE
  2334. '
  2335. '  NAME    -- GraphicX
  2336. '
  2337. '  INPUTS  --     PARAMETER                    MEANING
  2338. '                 Default$              USERS Graphic DEFAULT
  2339. '                 ZWasGR                WHETHER GRAPHICS ARE AVAILABLE
  2340. '                 FilName$              FILE TO CHECK
  2341. '                 FileNum               # of file to use
  2342. '
  2343. '  OUTPUTS --     FilName$              SUBSTITUTES NAME OF GRAPHICS
  2344. '                                       FILE (IF IT EXISTS).
  2345. '
  2346. '  PURPOSE -- Checks whether there is a graphics version of
  2347. '             a file, based on users graphics perference.
  2348. '             Sets file name to graphics file if it exists,
  2349. '             Otherwise leaves file name intact.  Returns file
  2350. '             name to use.
  2351. '
  2352.       SUB GraphicX (Default$,FilName$,FileNum) STATIC
  2353.       ZOK = ZFalse
  2354.       IF ZWasGR THEN _
  2355.          CALL BreakFileName (FilName$,DR$,WasX$,Extension$,ZTrue) : _
  2356.          IF LEN(WasX$) < 8 THEN _
  2357.             ZWasDF$ = DR$ + _
  2358.                   WasX$ + _
  2359.                   Default$ + _
  2360.                   Extension$ : _
  2361.              CALL FINDITX (ZWasDF$,FileNum) : _
  2362.              IF ZOK THEN _
  2363.                 FilName$ = ZWasDF$ : _
  2364.                 IF Default$ = "C" THEN _
  2365.                    ZLinesPrinted = 0
  2366.       IF NOT ZOK THEN _
  2367.          CALL FINDITX (FilName$,FileNum)
  2368.       END SUB
  2369. ' Sets Graphic version but uses file # 2 always
  2370.       SUB Graphic (Default$,FilName$) STATIC
  2371.       CALL GraphicX (Default$,FilName$,2)
  2372.       END SUB
  2373. 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile'
  2374. ' $PAGE
  2375. '
  2376. '  NAME    -- SaveProf
  2377. '
  2378. '  INPUTS  --     PARAMETER                    MEANING
  2379. '              ZBPS
  2380. '              ZEightBit
  2381. '              ZExitToDoors
  2382. '              ZWasGR
  2383. '              ZMsgRec$
  2384. '              ZNodeRecIndex
  2385. '              ZSysop
  2386. '              ZUpperCase
  2387. '              ZTimeLoggedOn$
  2388. '              ZPrivateDoor
  2389. '              ZReliableMode
  2390. '
  2391. '  OUTPUTS -- NONE
  2392. '
  2393. '  PURPOSE -- Saves a user's options and communications parameters
  2394. '             in the node record when a user exits to a "door" so
  2395. '             that he is in the same status as when he exited.
  2396. '
  2397.       SUB SaveProf (IParm) STATIC
  2398.       ON IParm GOTO 43070,43080
  2399. 43070 ZActiveMessageFile$ = ZOrigMsgFile$
  2400.       ZSubParm = 3
  2401.       CALL FileLock
  2402.       CALL OpenMsg
  2403.       FIELD 1, 128 AS ZMsgRec$
  2404.       GET 1,ZNodeRecIndex
  2405.       IF ZGlobalSysop THEN _
  2406.          MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
  2407.       MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
  2408.       MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
  2409.       MID$(ZMsgRec$,44,2) = STR$(ZBPS)
  2410.       MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
  2411.       MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2)
  2412.       MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
  2413.       MID$(ZMsgRec$,55,2) = STR$(ZSysop)
  2414.       MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZTimeLoggedOn$,2))) + _
  2415.                                    CHR$(VAL(MID$(ZTimeLoggedOn$,4,2))) + _
  2416.                                    CHR$(VAL(MID$(ZTimeLoggedOn$,7,2)))
  2417.       MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
  2418.       MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
  2419.       MID$(ZMsgRec$,75,1) = ZWasFT$
  2420.       MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
  2421.       MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+"        ",8)
  2422.       MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
  2423.       CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
  2424.       MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
  2425.       IF ZLocalUser THEN _
  2426.          ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _
  2427.       ELSE ZWasZ$ = " 0"
  2428.       MID$(ZMsgRec$,101,2) = ZWasZ$
  2429.       MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
  2430.       ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
  2431.       MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
  2432.       MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
  2433.       MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
  2434.       MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
  2435.       MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
  2436.       MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
  2437.       MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
  2438.       MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
  2439. ' ***   Save additional parameters for door restoral
  2440.       CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  2441.       CALL PrintWorkA (STR$(ZLimitMinsPerSession))
  2442.       CALL PrintWorkA (ZWasNG$)
  2443.       CALL PrintWorkA (ZIndivValue$)
  2444.       CALL PrintWorkA (ZOrigDateTimeOn$)
  2445.       CALL PrintWorkA (ZOrigTimeLoggedOn$)
  2446.       CALL PrintWorkA (STR$(ZUserFileIndex))
  2447.       CLOSE 2
  2448. 43080 PUT 1,ZNodeRecIndex
  2449.       ZSubParm = 2
  2450.       CALL FileLock
  2451.       CALL OpenMsg
  2452.       END SUB
  2453. 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
  2454. ' $PAGE
  2455. '
  2456. '  NAME    -- ReadProf
  2457. '
  2458. '  INPUTS  --     PARAMETER                    MEANING
  2459. '              ZNodeRecIndex               NODE RECORD TO USE
  2460. '              ZSysopPswd1$               Sysop'S PSEUDONYM 1
  2461. '              ZSysopPswd2$               Sysop'S PSEUDONYM 2
  2462. '
  2463. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2464. '             UPON EXITING RBBS-PC TO A "DOOR"
  2465. '
  2466. '  PURPOSE -- Reset a user's options and communications parameters
  2467. '             that were saved in the node record when a user exited
  2468. '             to a "door" so that he is in the same status as when
  2469. '             he exited.
  2470. '
  2471.       SUB ReadProf STATIC
  2472.       FIELD 1, 128 AS ZMsgRec$
  2473.       GET 1,ZNodeRecIndex
  2474.       ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
  2475.       MID$(ZMsgRec$,40,2) = "00"
  2476.       ZEightBit = VAL(MID$(ZMsgRec$,42,2))
  2477.       ZBPS = VAL(MID$(ZMsgRec$,44,2))
  2478.       CALL CommInfo
  2479.       ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
  2480.       ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
  2481.       ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))
  2482.       ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
  2483.       ZWasGR = VAL(MID$(ZMsgRec$,53,2))
  2484.       HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
  2485.       MinLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
  2486.       SecLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
  2487.       ZTimeLoggedOn$ = HourLoggedOn$ + _
  2488.                         ":" + _
  2489.                         MinLoggedOn$ + _
  2490.                         ":" + _
  2491.                         SecLoggedOn$
  2492.       ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
  2493.       ZWasFT$ = MID$(ZMsgRec$,75,1)
  2494.       ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2))
  2495.       ZDooredTo$ = MID$(ZMsgRec$,79,8)
  2496.       CALL Trim (ZDooredTo$)
  2497.       IF ZExitToDoors AND ZDooredTo$ <> "" THEN _
  2498.          CALL OpenWork (2,ZDoorsDef$) : _
  2499.          IF ZErrCode = 0 THEN _
  2500.             CALL ReadParms (ZOutTxt$(),8,1) : _
  2501.             WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
  2502.                CALL ReadParms (ZOutTxt$(),8,1) : _
  2503.             WEND : _
  2504.             IF ZOutTxt$(1) = ZDooredTo$ THEN _
  2505.                ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y")
  2506.       ZErrCode = 0
  2507.       ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
  2508.       ZCurPUI$ = MID$(ZMsgRec$,93,8)
  2509.       CALL Remove (ZCurPUI$," ")
  2510.       IF ZCurPUI$ <> "" THEN _
  2511.          CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
  2512.          ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
  2513.       ZCustomPUI = (ZCurPUI$ <> "")
  2514.       ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$)
  2515.       ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
  2516.       ZHomeConf$ = MID$(ZMsgRec$,105,8)
  2517.       ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
  2518.       CALL Trim (ZHomeConf$)
  2519.       IF ZHomeConf$ = "MAIN" THEN _
  2520.          ZHomeConf$ = ""
  2521.       IF ZRequiredRings > 0 AND _
  2522.          INSTR(ZModemInitCmd$,"S0=255") THEN _
  2523.          COLOR 7,0,0 _
  2524.       ELSE COLOR ZFG,ZBG,ZBorder
  2525.       IF ZLocalUserMode THEN _
  2526.          GOTO 44003
  2527.       CALL SetBaud
  2528. 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _
  2529.                         VAL(MinLoggedOn$) * 60! + _
  2530.                         VAL(SecLoggedOn$)
  2531.       HourLoggedOn$ = ""
  2532.       MinLoggedOn$ = ""
  2533.       SecLoggedOn$ = ""
  2534.       IF ZMinsPerSession < 1 THEN _
  2535.          ZMinsPerSession = 3
  2536.       IF NOT ZEightBit THEN _
  2537.          OUT ZLineCntlReg,&H1A
  2538.       IF LEFT$(ZMsgRec$,7) = "SYSOP  " THEN _
  2539.          ZFirstName$ = ZSysopPswd1$ : _
  2540.          ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2541.       ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
  2542.            ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " ","  ") : _
  2543.            ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
  2544.            ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
  2545.            ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
  2546.       ZWasZ$ = ZFirstName$
  2547.       CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  2548.       CALL ReadDir (2,1)
  2549.       ZLimitMinsPerSession = VAL (ZOutTxt$)
  2550.       CALL ReadDir (2,1)
  2551.       ZWasNG$ = ZOutTxt$
  2552.       CALL ReadDir (2,1)
  2553.       ZIndivValue$ = ZOutTxt$
  2554.       CALL ReadDir (2,1)
  2555.       ZOrigDateTimeOn$ = ZOutTxt$
  2556.       CALL ReadDir (2,1)
  2557.       ZOrigTimeLoggedOn$ = ZOutTxt$
  2558.       CALL ReadDir (2,1)
  2559.       ZUserFileIndex = VAL(ZOutTxt$)
  2560.       CLOSE 2
  2561.       CALL DoorReturn
  2562.       END SUB
  2563. 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
  2564. ' $PAGE
  2565. '
  2566. '  NAME    -- CommInfo
  2567. '
  2568. '  INPUTS  --     PARAMETER                    MEANING
  2569. '                 ZBPS                BAUD RATE INDICATOR
  2570. '                 ZEightBit           INDICATE FOR N/8/1
  2571. '
  2572. '  OUTPUTS -- ZBaudParity$
  2573. '
  2574. '  PURPOSE -- Create a string that shows a users baud rate and parity
  2575. '
  2576.       SUB CommInfo STATIC
  2577. '
  2578. '
  2579. ' *  DETERMINE BAUD AND PARITY
  2580. '
  2581. '
  2582.   IF ZReliableMode THEN _
  2583.      ReliableMode$ = "-R," _
  2584.   ELSE ReliableMode$ = ","
  2585.   ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
  2586.                  " BAUD" + _
  2587.                  ReliableMode$ + _
  2588.                  MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
  2589.   ZBaudTest! = VAL(ZBaudParity$)
  2590.   END SUB
  2591. 50495 ' $SUBTITLE: 'DelayTime - sub to wait number of seconds specified'
  2592. ' $PAGE
  2593. '
  2594. '  NAME    -- DelayTime
  2595. '
  2596. '  INPUTS  --     PARAMETER                    MEANING
  2597. '                 DelaySecs           NUMBER OF SECONDS TO DELAY
  2598. '                                      (0 TO 3,600)
  2599. '
  2600. '  OUTPUTS -- NONE
  2601. '
  2602. '  PURPOSE -- To wait the number of seconds indicated before
  2603. '             returning control to the calling routine.
  2604. '
  2605.       SUB DelayTime (DelaySecs) STATIC
  2606.       IF DelaySecs < 1 THEN _
  2607.          EXIT SUB
  2608.       ZDelay! = TIMER + DelaySecs
  2609. 50500 CALL CheckTime(ZDelay!, TempElapsed!, 1)
  2610.       IF TempElapsed! > 0 THEN _
  2611.          GOTO 50500
  2612.       END SUB
  2613. 52070 ' $SUBTITLE: 'ModemPut - sub to write modem commands to modem'
  2614. ' $PAGE
  2615. '
  2616. '  SUBROUTINE NAME    -- ModemPut
  2617. '
  2618. '  INPUT PARAMETERS   --     PARAMETER               MEANING
  2619. '                            Strng$                MODEM COMMAND
  2620. '                            ZCmdsBetweenRings     INDICATOR TO WAIT FOR
  2621. '                                                  MODEM TO STOP RINGING
  2622. '                                                  BEFORE ISSUING COMMANDS
  2623. '                            ZDumbModem            INDICATOR THAT MODEM WOULD
  2624. '                                                  NOT UNDERSTAND COMMANDS
  2625. '
  2626. '  OUTPUT PARAMETERS  -- NONE
  2627. '
  2628. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2629. '
  2630.       SUB ModemPut (Strng$) STATIC
  2631. '
  2632. '
  2633. ' *  SEND MODEM COMMAND
  2634. '
  2635. '
  2636.       IF ZDumbModem THEN _
  2637.          EXIT SUB
  2638.       IF NOT ZCmdsBetweenRings OR _
  2639.          NOT (INP(ZModemStatusReg) AND &H40) THEN _
  2640.          GOTO 52080
  2641.       ConnectDelay! = TIMER + 7
  2642. 52072 IF (INP(ZModemStatusReg) AND &H40) > 0 THEN _
  2643.          CALL CheckTime(ConnectDelay!, TempElapsed!, 1) : _
  2644.          IF ZSubParm = 2 THEN _
  2645.             GOTO 52080
  2646.       GOTO 52072
  2647. 52080 CALL DelayTime (ZModemCmdDelayTime)
  2648.       WasX$ = " "
  2649.       FOR WasI = 1 TO LEN(Strng$)
  2650.          LSET WasX$ = MID$(Strng$,WasI,1)
  2651.          ON INSTR("{~",WasX$) GOTO 52082,52084
  2652.             GOTO 52085
  2653. 52082       LSET WasX$ = ZCarriageReturn$
  2654.             GOTO 52085
  2655. 52084       CALL DelayTime (1)
  2656.             GOTO 52086
  2657. 52085    CALL CommPut (WasX$)
  2658. 52086 NEXT
  2659.       CALL CommPut (ZCarriageReturn$)
  2660.       END SUB
  2661. 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
  2662. ' $PAGE
  2663. '
  2664. '  NAME    -- DispCall
  2665. '
  2666. '  INPUTS  --     PARAMETER           MEANING
  2667. '
  2668. '  OUTPUTS --  (NONE)
  2669. '
  2670. '  PURPOSE -- Displays callers file to sysops and callers
  2671. '
  2672.       SUB DispCall STATIC
  2673.       IF ZCallersFilePrefix$ = "" THEN _
  2674.          EXIT SUB
  2675.       CALL SkipLine (1)
  2676.       CallersFileIndexTemp! = ZCallersFileIndex!
  2677.       CLOSE 4
  2678.       IF ZShareIt THEN _
  2679.          OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  2680.       ELSE OPEN "R",4,ZCallersFile$,64
  2681.       FIELD 4,64 AS ZCallersRecord$
  2682. 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _
  2683.          EXIT SUB
  2684. 57010 GET 4,CallersFileIndexTemp!
  2685.       ZOutTxt$ = ZCallersRecord$
  2686.       IF LEFT$(ZOutTxt$,3) = "   " OR _
  2687.          INSTR(ZOutTxt$,"on at") = 0 THEN _
  2688.          GOTO 57030
  2689. 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
  2690.       GET 4,CallersFileIndexTemp!
  2691.       WasZ = INSTR(ZCallersRecord$,"{")
  2692.       IF WasZ < 1 OR WasZ > 15 THEN _
  2693.          WasZ = 15
  2694.       IF ZSysop OR _
  2695.          LEFT$(ZOutTxt$,3) <> "   " THEN _
  2696.          ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
  2697.       GOSUB 57100
  2698.       IF ZSysop THEN _
  2699.          ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
  2700.          GOSUB 57100
  2701.       GOTO 57045
  2702. 57030 IF ZSysop THEN _
  2703.          GOSUB 57100
  2704. 57045 CallersFileIndexTemp! = CallersFileIndexTemp! -1
  2705.       GOTO 57005
  2706. 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
  2707.          IF NOT ZSysop THEN _
  2708.             RETURN
  2709.       CALL QuickTPut1 (ZOutTxt$)
  2710.       CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  2711.       IF ZNo OR ZSubParm = -1 THEN _
  2712.          EXIT SUB
  2713.       RETURN
  2714.       END SUB
  2715. 58050 ' $SUBTITLE: 'AllCaps - sub to convert string to upper case'
  2716. ' $PAGE
  2717. '
  2718. '  NAME    -- AllCaps
  2719. '
  2720. '  INPUTS  --     PARAMETER           MEANING
  2721. '              ConvertField$    STRING TO MAKE UPPER CASE
  2722. '
  2723. '  OUTPUTS --  ConvertField$    CONVERTED STRINGS
  2724. '
  2725. '  PURPOSE -- Subroutine to convert a string to upper case
  2726. '
  2727.       SUB AllCaps (ConvertField$) STATIC
  2728.       IF ZTurboRBBS THEN _
  2729.          CALL RBBSULC (ConvertField$) : _
  2730.          EXIT SUB
  2731.       FOR WasZ = 1 TO LEN(ConvertField$)
  2732.          WasX = ASC(MID$(ConvertField$,WasZ,1))
  2733.          IF WasX > 96 THEN IF WasX < 123 THEN _
  2734.             MID$(ConvertField$,WasZ,1) = CHR$(WasX AND 223)
  2735.       NEXT
  2736.       END SUB
  2737. 58060 ' $SUBTITLE: 'NameCaps - sub to convert name string to Proper Case'
  2738. ' $PAGE
  2739. '
  2740. '  NAME    -- NameCaps
  2741. '
  2742. '  INPUTS  --     PARAMETER           MEANING
  2743. '              ConvertField$    STRING TO CONVERT
  2744. '
  2745. '  OUTPUTS --  ConvertField$    CONVERTED STRINGS
  2746. '
  2747. '  PURPOSE -- Subroutine to convert a string to Proper Case (1st char upper)
  2748. '
  2749.       SUB NameCaps (ConvertField$) STATIC
  2750.       CALL AllCaps(ConvertField$)
  2751.       FOR WasZ = 2 TO LEN(ConvertField$)
  2752.          IF MID$(ConvertField$,WasZ,1) > "@" AND _
  2753.             MID$(ConvertField$,WasZ,1) < "[" AND _
  2754.             MID$(ConvertField$,WasZ-1,1) <> " " THEN _
  2755.             MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) OR 32)
  2756.       NEXT
  2757.       END SUB
  2758. 58070 ' $SUBTITLE: 'CheckTime - sub to see how much time is remaining'
  2759. ' $PAGE
  2760. '
  2761. '  NAME    -- CheckTime
  2762. '
  2763. '  INPUTS  -- PARAMETER               MEANING
  2764. '             TargetTime              TARGET TIME
  2765. '             ChectimeOption      1 = TELL US TIME REMAINING BETWEEN CURRENT
  2766. '                                     TIME AND TargetTime
  2767. '                                 2 = TELL US TIME ELAPSED BETWEEN TargetTime
  2768. '                                     AND CURRENT TIME
  2769. '
  2770. '  OUTPUTS -- PARAMETER               MEANING
  2771. '             TimeRemaining!      POSITIVE OR NEGATIVE NUMBER INDICATING
  2772. '                                 TIME REMAINING OR ELAPSED.  VALUE MAY BE
  2773. '                                 TESTED FOR "TIME EXPIRED".  NEGATIVE
  2774. '                                 OR ZERO, AND THE TIME HAS BEEN REACHED.
  2775. '                                 ELAPSED TIME CAN BE 0 TO 86400 (24 HRS)
  2776. '                                 TIME REMAINING CAN BE 0 TO 43200 OR
  2777. '                                  -43200 TO 0 (+ OR - 12 HRS)
  2778. '             ZSubParm (Option 1 ONLY!)
  2779. '                                 1 = Time REMAINING is > 0
  2780. '                                 2 = Time REMAINING is <= 0
  2781. '
  2782. '
  2783. '  PURPOSE -- Subroutine to provide time measurement functions.  Will
  2784. '             determine whether a target time has been reached, how much
  2785. '             time is remaining, or how much time has elapsed.
  2786. '
  2787.       SUB CheckTime (TargetTime!, TimeRemaining!, CkOption) STATIC
  2788.       IF TargetTime! > 86400 THEN _
  2789.          TestTime! = 86400 : _
  2790.          OverTime! = TargetTime! - 86400 _
  2791.       ELSE _
  2792.          TestTime! = TargetTime! : _
  2793.          OverTime! = 0
  2794.       TimeRemaining! = (TestTime! - TIMER) + OverTime!
  2795.       IF CkOption = 2 THEN GOTO 58072
  2796.       IF TimeRemaining! < -43200 THEN _
  2797.          TimeRemaining! = TimeRemaining! + 86400
  2798.       IF TimeRemaining! > 43200 THEN _
  2799.          TimeRemaining! = TimeRemaining! - 86400
  2800.       IF TimeRemaining! >= 0 THEN _
  2801.          ZSubParm = 1 _
  2802.       ELSE _
  2803.          ZSubParm = 2
  2804.       EXIT SUB
  2805. 58072 IF TimeRemaining! > 0 THEN _
  2806.          TimeRemaining! = 86400 - TimeRemaining! _
  2807.       ELSE _
  2808.          TimeRemaining! = -(TimeRemaining!)
  2809.       END SUB
  2810. 58080 ' $SUBTITLE: 'HashRBBS - sub to determine where to look for user'
  2811. ' $PAGE
  2812. '
  2813. '  NAME    -- HashRBBS
  2814. '
  2815. '  INPUTS  --     PARAMETER           MEANING
  2816. '               StringToHash$    USER NAME TO LOCATE
  2817. '               MaxPosition      MAXIMUM # USERS
  2818. '
  2819. '  OUTPUTS --     PrimeHash       WHERE TO LOOK First
  2820. '                SecondHash       LOOK THIS FAR AHEAD
  2821. '
  2822. '  PURPOSE -- Where to look for a user in users file
  2823. '             Look first at prime position, then add
  2824. '             SecondHash until find or find unused record
  2825. '
  2826.       SUB HashRBBS (StringToHash$,MaxPosition,PrimeHash,SecondHash) STATIC
  2827.       SecondHash = (ASC(MID$(StringToHash$,2,1)) * 10  + 7) MOD _
  2828.            MaxPosition
  2829.       PrimeHash = _
  2830.            ((ASC(StringToHash$) * 100  + _
  2831.              ASC(MID$(StringToHash$,(LEN(StringToHash$) / 2) + .1,1)) * _
  2832.              10  + _
  2833.              ASC(RIGHT$(StringToHash$,1))) _
  2834.              MOD MaxPosition) + 1
  2835.       END SUB
  2836. 58100 ' $SUBTITLE: 'SetOpts - sub to set prompts based on user security'
  2837. ' $PAGE
  2838. '
  2839. '  NAME    -- SetOpts
  2840. '
  2841. '  INPUTS  --     PARAMETER           MEANING
  2842. '                   First             POSITION WHERE START LOOKING
  2843. '                   Last              POSITION WHERE QUIT LOOKING
  2844. '                   ZUserSecLevel     SECURITY OF USER
  2845. '
  2846. '  OUTPUTS -- Options$              LIST OF COMMANDS USER CAN DO
  2847. '
  2848. '  PURPOSE -- String together what commands user can do in a section
  2849. '
  2850.       SUB SetOpts (Options$,InvalidOptions$,First,Last) STATIC
  2851.       Options$ = ""
  2852.       InvalidOptions$ = ""
  2853.       FOR WasI = First TO Last
  2854.          IF ZUserSecLevel < ZOptSec(WasI) THEN _
  2855.             InvalidOptions$ = InvalidOptions$ + _
  2856.                                MID$(ZAllOpts$,WasI,1) _
  2857.          ELSE IF MID$(ZAllOpts$,WasI,1) <> " " THEN _
  2858.                  Options$ = Options$ + _
  2859.                             MID$(ZAllOpts$,WasI,1)
  2860.       NEXT
  2861.       CALL SortString (Options$)
  2862.       CALL SortString (InvalidOptions$)
  2863.       END SUB
  2864. 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
  2865. ' $PAGE
  2866. '
  2867. '  NAME    -- CheckNewBul
  2868. '
  2869. '  INPUTS  --     PARAMETER           MEANING
  2870. '                 LastOn$             Last DATE OF LOGON
  2871. '                                   FORMAT MM/DD/YY
  2872. '                 ZActiveBulletins  # OF BULLETING
  2873. '                 ZBulletinPrefix$  FILESPEC FOR BULLETINS
  2874. '
  2875. '  OUTPUTS --     NumNewBullets   NUMBER OF NEW BULLETINS
  2876. '                 NewBullets$      LIST OF NEW BULLET #'S
  2877. '                 ZWasQ            WHERE Last BULLETIN STORED
  2878. '                                  IN ZUserIn$()
  2879. '                 ZUserIn$()       BULLETINS #'S THAT ARE NEW
  2880. '                                    (2,3,4,...)
  2881. '
  2882. '  PURPOSE -- Checks how many bulletins have system date
  2883. '             at or later than date caller last logged on
  2884. '
  2885.       SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
  2886.       IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
  2887.          EXIT SUB
  2888.       ZPrevPrefix$ = ZBulletinPrefix$
  2889.       NumNewBullets = 0
  2890.       NewBullets$ = ""
  2891.       BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
  2892.                    (10000# * (1900 + VAL(MID$(LastOn$,7,2))))
  2893.       CALL FindIt (ZBulletinPrefix$ + ".FCK")
  2894.       WasX = 0
  2895.       CALL QuickTPut ("Checking new bulletins",0)
  2896.       IF ZOK THEN _
  2897.          WHILE NOT EOF(2) : _
  2898.             INPUT #2,WasBN$ : _
  2899.             GOSUB 58112 : _
  2900.          WEND _
  2901.       ELSE FOR WasI = 1 TO ZActiveBulletins : _
  2902.               WasBN$ = MID$(STR$(WasI),2) : _
  2903.               GOSUB 58112 : _
  2904.            NEXT
  2905.       ZWasQ = NumNewBullets + 1
  2906.       IF NumNewBullets < 1 THEN _
  2907.          NewBullets$ = ""
  2908.       CALL SkipLine (1)
  2909.       ZOutTxt$ = STR$(NumNewBullets) + _
  2910.            " New bulletin(s) since last call"
  2911.       CALL QuickTPut1 (ZOutTxt$)
  2912.       CALL BufString (NewBullets$,4096,WasX)
  2913.       CALL SkipLine (1)
  2914.       EXIT SUB
  2915. 58112 FirstWord$ = WasBN$
  2916.       CALL Trim (FirstWord$)
  2917.       FirstWord$ = LEFT$(FirstWord$,INSTR(FirstWord$+" "," ")-1)
  2918.       IF FirstWord$ = "N" THEN _
  2919.          WasX$ = ZNewsFileName$ + CHR$(0) _
  2920.       ELSE WasX$ = ZBulletinPrefix$ + FirstWord$ + CHR$(0)
  2921.       CALL MarkTime (WasX)
  2922.       CALL RBBSFind (WasX$,WasIX,Year,WasMM,WasDD)
  2923.       IF WasIX = 0 THEN _
  2924.          FDate# = WasDD + (100 * WasMM) + (10000# * (Year + 1980)) : _
  2925.          IF BaseDate# <= FDate# THEN _
  2926.             NumNewBullets = NumNewBullets + 1 : _
  2927.             ZUserIn$(NumNewBullets + 1) = FirstWord$ : _
  2928.             NewBullets$ = NewBullets$ + " " + WasBN$
  2929.       RETURN
  2930.       END SUB
  2931. 58120 ' $SUBTITLE: 'SortString - sub to sort characters in a string'
  2932. ' $PAGE
  2933. '
  2934. '  NAME    -- SortString
  2935. '
  2936. '  INPUTS  --     PARAMETER           MEANING
  2937. '                 Strng$           STRING TO SORT
  2938. '
  2939. '  OUTPUTS --     Strng$           SORTED STRING
  2940. '
  2941. '  PURPOSE -- Sorts characters in passed string.
  2942. '
  2943.       SUB SortString (Strng$) STATIC
  2944.       Sort0 = LEN(Strng$)
  2945.       Sort1 = Sort0
  2946.       WasX$ = "!"
  2947. 58122 Sort1 = Sort1\2
  2948.       IF Sort1 = 0 THEN _
  2949.          EXIT SUB
  2950.       Sort2 = Sort0 - Sort1
  2951.       FOR Sort3 = 1 TO Sort2
  2952.          Sort4 = Sort3
  2953. 58124    Sort5 = Sort4 + Sort1
  2954.          IF MID$(Strng$,Sort4,1) > MID$(Strng$,Sort5,1) THEN _
  2955.             LSET WasX$ = MID$(Strng$,Sort4,1) : _
  2956.             MID$(Strng$,Sort4,1) = MID$(Strng$,Sort5,1) : _
  2957.             MID$(Strng$,Sort5,1) = WasX$ : _
  2958.             Sort4 = Sort4 - Sort1 : _
  2959.             IF Sort4 > 0 THEN _
  2960.                GOTO 58124
  2961.       NEXT
  2962.       GOTO 58122
  2963.       END SUB
  2964. 58130 ' $SUBTITLE: 'AddCommas - sub to format commands in command prompt'
  2965. ' $PAGE
  2966. '
  2967. '  NAME    -- AddCommas
  2968. '
  2969. '  INPUTS  --     PARAMETER           MEANING
  2970. '                 Strng$           STRING TO REPLACE
  2971. '
  2972. '  OUTPUTS --     Strng$           REPLACED STRING
  2973. '
  2974. '  PURPOSE -- Inserts commands between each letter in Strng$
  2975. '             and encloses in pointed brackets
  2976. '
  2977.       SUB AddCommas (Strng$) STATIC
  2978.       WasL = LEN(Strng$)
  2979.       IF WasL < 1 THEN _
  2980.          EXIT SUB
  2981.       LSET ZLineMes$ = " <" + _
  2982.                       LEFT$(Strng$,1)
  2983.       FOR WasK = 2 TO WasL
  2984.          MID$(ZLineMes$,2 * WasK,2) = "," + _
  2985.                                   MID$(Strng$,WasK,1)
  2986.       NEXT
  2987.       Strng$ = LEFT$(ZLineMes$,2 * WasL + 1) + _
  2988.                ">"
  2989.       END SUB
  2990. 58140 ' $SUBTITLE: 'LoadNew - subroutine to get latest uploads'
  2991. ' $PAGE
  2992. '
  2993. '  NAME    -- LoadNew
  2994. '
  2995. '  INPUTS  --     PARAMETER           MEANING
  2996. '               ZUpldDir$             LIST OF FILES UPLOADED
  2997. '
  2998. '  OUTPUTS --   ZOutTxt$              LATEST UPLOADS
  2999. '
  3000. '  PURPOSE -- Loads table of most recent number of uploads by date
  3001. '
  3002.       SUB LoadNew (Ara(2)) STATIC
  3003.       IF ZFMSDirectory$ = "" THEN _
  3004.          EXIT SUB
  3005.       ZPrevBase$ = ""
  3006.       FirstWarning = ZTrue
  3007.       IF PrevLoadNew$ = ZFMSDirectory$ THEN _
  3008.          Ara(1,1) = 0 : _
  3009.          EXIT SUB
  3010. 58141 PrevLoadNew$ = ZFMSDirectory$
  3011.       CALL OpenFMS (LastRec)
  3012.       FIELD 2, 23 AS PreDate$, _
  3013.                 2 AS WasMM$, _
  3014.                 1 AS Fill1$, _
  3015.                 2 AS WasDD$, _
  3016.                 1 AS Fill2$, _
  3017.                 2 AS Year$, _
  3018.                 (2 + ZMaxDescLen) AS Desc$, _
  3019.                 3 AS Category$, _
  3020.                 2 AS Fill4$
  3021.       MaxRecs = UBOUND(Ara,1)
  3022.       IF MaxRecs < 1 THEN _
  3023.          MaxRecs = 1 _
  3024.       ELSE IF MaxRecs > 23 THEN _
  3025.               MaxRecs = 23
  3026.       WasL = 0
  3027.       WasK = LastRec
  3028.       WHILE WasK > 0 AND WasL < MaxRecs
  3029.          GET #2,WasK
  3030.          IF INSTR("*\ ",LEFT$(PreDate$,1)) > 0 THEN _
  3031.             GOTO 58142
  3032.          IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
  3033.             IF VAL(Year$) > 79 THEN _
  3034.                WasL = WasL + 1 : _
  3035.                Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _
  3036.             ELSE IF FirstWarning THEN _
  3037.                     FirstWarning = ZFalse : _
  3038.                     ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _
  3039.                     ZSnoop = ZTrue : _
  3040.                     CALL LPrnt (ZWasZ$,1) : _
  3041.                     CALL UpdtCalr (ZWasZ$,2)
  3042.          IF NOT ZCanDnldFromUp THEN _
  3043.             WasX = ZMinSecToView _
  3044.          ELSE IF Category$ = "***" THEN _
  3045.                  WasX = ZSysopSecLevel _
  3046.               ELSE IF Category$ = ZDefaultCatCode$ THEN _
  3047.                       WasX = ZMinSecToView _
  3048.               ELSE IF LEFT$(PreDate$,1) = "=" THEN _
  3049.                       CALL CheckInt (Desc$) : _
  3050.                       WasX = ZTestedIntValue _
  3051.               ELSE WasX = ZOptSec(19)
  3052.          Ara(WasL,2) = WasX
  3053. 58142    WasK = WasK - 1
  3054.       WEND
  3055.       CLOSE 2
  3056.       IF ZUpInc > 0 AND ZChainedDir$ <> "" THEN _
  3057.          ZActiveFMSDir$ = ZChainedDir$ : _
  3058.          GOTO 58141
  3059.       END SUB
  3060. 58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
  3061. ' $PAGE
  3062. '
  3063. '  NAME    -- CountNewFiles
  3064. '
  3065. '  INPUTS  --     PARAMETER           MEANING
  3066. '                  LastOn$          Date of last logon
  3067. '                  UPLDS$            Latest uploads
  3068. '
  3069. '  OUTPUTS --    NumNewFiles       How many after last logon
  3070. '                RptPrefix$         Set to "At least " if
  3071. '                                    above is a minimum
  3072. '
  3073. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  3074. '             after date of last logon that the user can download
  3075. '
  3076.       SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC
  3077.       BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
  3078.                   31 * (VAL(MID$(LastOn$,1,2))) + _
  3079.                   VAL(MID$(LastOn$,4,2))
  3080.       NumNewFiles = 1
  3081.       NumUserFiles = 0
  3082.       WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
  3083.                 Upld(NumNewFiles,1) > 0 AND _
  3084.                 NumNewFiles < UBOUND(Upld,1))
  3085.          IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
  3086.             NumUserFiles = NumUserFiles + 1
  3087.          NumNewFiles = NumNewFiles + 1
  3088.       WEND
  3089.       IF Upld(NumNewFiles,1) < 1 THEN _
  3090.          NumNewFiles = NumNewFiles - 1
  3091.       IF BaseDate <= Upld(NumNewFiles,1) THEN _
  3092.          RptPrefix$ = "At least" _
  3093.       ELSE RptPrefix$ = ""
  3094.       END SUB
  3095. 58160 ' $SUBTITLE: 'CountLines - sub to determine file categories '
  3096. ' $PAGE
  3097. '
  3098. '  NAME    -- CountLines
  3099. '
  3100. '  INPUTS  -- PARAMETER             MEANING
  3101. '             ZDirCatFile$          NAME OF THE FILE THAT HAS THE
  3102. '                                   NUMBER OF CATEGORIES IN IT.
  3103. '
  3104. '  OUTPUTS -- MaxEntries           NUMBER OF FILE CATEGORIES
  3105. '
  3106. '  PURPOSE -- Subroutine to count the number of categories that a
  3107. '             file can be classified into.
  3108. '
  3109.  
  3110.       SUB CountLines (MaxEntries) STATIC
  3111.       CALL LinesInFile (ZDirCatFile$,MaxEntries)
  3112.       MaxEntries = MaxEntries + 4
  3113.       IF MaxEntries < 10 THEN _
  3114.          MaxEntries = 10
  3115.       END SUB
  3116. 58161 ' $SUBTITLE: 'CountLines - sub to determine file categories '
  3117. ' $PAGE
  3118. '
  3119. '  NAME    -- LinesInFile
  3120. '
  3121. '  INPUTS  -- PARAMETER             MEANING
  3122. '             FilName$              Name of file to use
  3123. '
  3124. '  OUTPUTS -- LineCount                  Count of # of lines in file
  3125. '
  3126. '  PURPOSE -- Subroutine to count the number of categories that a
  3127. '             file can be classified into.
  3128. '
  3129.       SUB LinesInFile (FilName$,LineCount) STATIC
  3130.       CALL FindIt (FilName$)
  3131.       LineCount = 0
  3132.       IF ZOK THEN _
  3133.          WHILE NOT EOF(2) : _
  3134.             LineCount = LineCount + 1 : _
  3135.             LINE INPUT #2,ZOutTxt$ : _
  3136.          WEND
  3137.       CLOSE 2
  3138.       END SUB
  3139. 58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system'
  3140. ' $PAGE
  3141. '
  3142. '  NAME    -- InitFMS
  3143. '
  3144. '  INPUTS  -- PARAMETER             MEANING
  3145. '             ZFMSDirectory$
  3146. '
  3147. '  OUTPUTS -- ZCategoryName$()  ELEMENTS 1,2, POSSIBLY MORE
  3148. '             ZCategoryCode$()  ELEMENTS 1,2, POSSIBLY MORE
  3149. '             ZCategoryDesc$()  ELEMENTS 1,2, POSSIBLY MORE
  3150. '             CategoryIndex     COUNT OF # ELEMENTS IN THE FILE
  3151. '                               MANAGMENT SYSTEM
  3152. '
  3153. '  PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
  3154. '
  3155.       SUB InitFMS (CategoryIndex) STATIC
  3156.       Blank$ = " "
  3157.       CategoryIndex = 0
  3158.       IF ZFMSDirectory$ <> "" THEN _
  3159.          CategoryIndex = CategoryIndex + 1 : _
  3160.          CatN$ = ZCategoryName$(CategoryIndex) : _
  3161.          CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _
  3162.          ZCategoryName$(CategoryIndex) = CatN$ : _
  3163.          ZCategoryCode$(CategoryIndex) = "" : _
  3164.          ZCategoryDesc$(CategoryIndex) = "All uploads"_
  3165.       ELSE ZLimitSearchToFMS = ZFalse : _
  3166.            EXIT SUB
  3167.       IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _
  3168.          CategoryIndex = CategoryIndex + 1 : _
  3169.          ZCategoryName$(CategoryIndex) = "ALL" : _
  3170.          ZCategoryCode$(CategoryIndex) = "" : _
  3171.          ZCategoryDesc$(CategoryIndex) = "All files"
  3172.       CALL FindIt (ZDirCatFile$)
  3173.       IF NOT ZOK THEN _
  3174.          EXIT SUB
  3175.       WHILE NOT EOF(2)
  3176.          CALL ReadParms (ZWorkAra$(),3,1)
  3177.          IF ZErrCode > 0 THEN _
  3178.             ZErrCode = 0 : _
  3179.             CALL PScrn (ZDirCatFile$+" invalid.  Line" + STR$(CategoryIndex) + " needs 3 parms") : _
  3180.             CALL DelayTime (4) _
  3181.          ELSE CategoryIndex = CategoryIndex + 1 : _
  3182.               ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _
  3183.               ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _
  3184.               ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _
  3185.               CatR$ = ZCategoryCode$(CategoryIndex) : _
  3186.               CALL Remove (CatR$,Blank$) : _
  3187.               ZCategoryCode$(CategoryIndex) = CatR$
  3188.       WEND
  3189.       CLOSE 2
  3190.       END SUB
  3191. 58165 ' $SUBTITLE: 'DispUpDir - sub to display upload direcotry'
  3192. ' $PAGE
  3193. '
  3194. '  NAME    -- DispUpDir
  3195. '
  3196. '  INPUTS  -- PARAMETER             MEANING
  3197. '             PassedCats$         FILE "CATEGORIES" TO BE INCLUDED IN
  3198. '                                 THE SEARCH.
  3199. '             SearchString$       STRING TO SEARCH ON WITHIN THE
  3200. '                                 FILE "CATEGORIES" SELECTED
  3201. '             SearchDate$         DATE EQUAL TO OR GREATER THAN TO BE
  3202. '                                 SEARCHED FOR WITH THE "CATEGORIES"
  3203. '                                 AND THE STRING TO SEARCH.
  3204. '             DnldFlag            SET TO RECORD # OF LINE TO BEGIN
  3205. '                                 VIEWING - 0 IF AT END
  3206. '
  3207. '  OUTPUTS -- DnldFlag            WHENEVER DOWNLOAD REQUESTED, SETS
  3208. '                                 TO NEXT RECORD TO VIEW.  OTHERWISE
  3209. '                                 LEAVES AT ZERO
  3210. '  PURPOSE -- Display the files that meet the criteria selected in
  3211. '             RBBS-PC upload management system on the users screen.
  3212. '
  3213.       SUB DispUpDir (PassedCats$,SearchString$, _
  3214.                     SearchDate$,DnldFlag,AbortIndex) STATIC
  3215.       CALL AllCaps (SearchString$)
  3216.       Blank$ = " "
  3217.       ZStopInterrupts = ZFalse
  3218.       ZLastIndex = 0
  3219.       Categories$ = "," + _
  3220.                     PassedCats$ + _
  3221.                     ","
  3222.       CanDnld = (ZUserSecLevel => ZOptSec(19))
  3223.       CanView = (ZUserSecLevel => ZOptSec(26))
  3224.       ZJumpSupported = ZTrue
  3225.       ZJumpSearching = ZFalse
  3226.       GOSUB 58185
  3227.       IF DnldFlag > 0 THEN _
  3228.          UpldIndex = DnldFlag : _
  3229.          DnldFlag = 0 : _
  3230.          GOTO 58180
  3231.       ZJumpLast$ = ""
  3232.       SearchFor$ = SearchString$
  3233.       ExtraPrompt$ = LEFT$(",V)iew",-(6+4*ZExpertUser)*CanView)
  3234.       IF CanDnld THEN _
  3235.          IF ZTurboKeyUser THEN _
  3236.             ExtraPrompt$ = ExtraPrompt$ + ",D)ownload" _
  3237.          ELSE ExtraPrompt$ = ExtraPrompt$ + ", file(s) to dwnld"
  3238.       MaxPrint = ZPageLength - 1
  3239.       BelowMinSec = (ZUserSecLevel < ZMinSecToView)
  3240.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  3241.       FMSCheckPoint = 0
  3242.       WildSearch = (INSTR(SearchString$,"?") > 0) _
  3243.                      OR (INSTR(SearchString$,"*") > 0)
  3244. 58168 UpldIndex = UpldIndex + ZUpInc
  3245.       IF UpldIndex = CutoffRec OR UpldIndex < 1 THEN _
  3246.          GOTO 58182
  3247.       GET #2,UpldIndex
  3248.       FMSCheckPoint = FMSCheckPoint + 1
  3249.       ON INSTR("\* =",LEFT$(PartToPrint$,1)) GOTO 58168,58171,58170,58169
  3250.       GOTO 58172
  3251. 58169 CALL CheckInt (MID$(PartToPrint$,34))
  3252.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3253.          LastOK = ZFalse : _
  3254.          FailedSearch = ZFalse : _
  3255.          GOTO 58168
  3256.       MID$(PartToPrint$,1,13) = MID$(PartToPrint$,2,12) + " "
  3257.       ZWasA = LEN(STR$(ZTestedIntValue))
  3258.       MID$(PartToPrint$,34) = MID$(PartToPrint$,34 + ZWasA) + SPACE$(ZWasA)
  3259.       GOTO 58172
  3260. 58170 IF ZExtendedOff THEN _
  3261.          GOTO 58168 _
  3262.       ELSE IF LastOK THEN _
  3263.          GOTO 58175 _
  3264.       ELSE IF ZJumpSearching THEN _
  3265.               GOTO 58187 _
  3266.            ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _
  3267.                    GOTO 58187 _
  3268.                 ELSE GOTO 58168
  3269. 58171 IF Category$ = "***" THEN _
  3270.          GOTO 58176 _
  3271.       ELSE HoldCat$ = "," + Category$ + "," : _
  3272.            IF INSTR(Categories$,HoldCat$) > 0 THEN _
  3273.               GOTO 58176 _
  3274.            ELSE GOTO 58168
  3275. 58172 LastOK = ZFalse
  3276.       FailedSearch = ZFalse
  3277.       LastFName = UpldIndex
  3278.       IF Category$ = "***" THEN _
  3279.          IF NOT ZSysop THEN _
  3280.             GOTO 58178
  3281.       IF Category$ = ZDefaultCatCode$ THEN _
  3282.          IF BelowMinSec THEN _
  3283.             GOTO 58178
  3284. 58173 IF LEN(Categories$) > 2 THEN _
  3285.          HoldCat$ = "," + _
  3286.                 Category$ + _
  3287.                 "," : _
  3288.          CALL Remove (HoldCat$,Blank$) : _
  3289.          IF INSTR(Categories$,HoldCat$) = 0 THEN _
  3290.             GOTO 58178
  3291.       IF ZJumpSearching OR SearchString$ <> "" THEN _
  3292.          ZOutTxt$ = PartToPrint$ : _
  3293.          IF WildSearch THEN _
  3294.             Temp$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ")-1) : _
  3295.             Temp$ = MID$(Temp$,1-(LEFT$(Temp$,1)="=")) : _
  3296.             CALL WildFile (SearchString$,Temp$,ZOK) : _
  3297.             IF ZOK THEN _
  3298.                FoundString$ = SearchString$ : _
  3299.                GOTO 58175 _
  3300.             ELSE GOTO 58178 _
  3301.          ELSE CALL AllCaps (ZOutTxt$) : _
  3302.               HiLitePos = INSTR(ZOutTxt$,SearchFor$) : _
  3303.               IF HiLitePos = 0 THEN _
  3304.                  FailedSearch = ZTrue : _
  3305.                  GOTO 58178 _
  3306.               ELSE HiLiteRec = UpldIndex : _
  3307.                    FoundString$ = SearchFor$ : _
  3308.                    IF ZJumpSearching THEN _
  3309.                       ZJumpSearching = ZFalse : _
  3310.                       SearchFor$ = PrevSearch$
  3311. 58174 IF SearchDate$ <> "" THEN _
  3312.          HoldCat$ = MID$(PartToPrint$,30,2) + _
  3313.                 MID$(PartToPrint$,24,2) + _
  3314.                 MID$(PartToPrint$,27,2) : _
  3315.          IF HoldCat$ < SearchDate$ THEN _
  3316.             IF ZDateOrderedFMS THEN _
  3317.                GOTO 58183 _
  3318.             ELSE GOTO 58168
  3319. '
  3320. '
  3321. ' * Allow the FMS to be both fast and interruptable if a local
  3322. ' * user or there is nothing in the input buffer by using QuickTPut.
  3323. '
  3324. '
  3325. 58175 LastOK = ZTrue
  3326. 58176 ZWasA = EndDesc
  3327.       IF LEFT$(PartToPrint$,5) = "     " THEN _
  3328.          GOTO 58178
  3329.       ZOutTxt$ = PartToPrint$
  3330.       CALL TrimTrail (ZOutTxt$," ")
  3331.       CALL ColorDir (ZOutTxt$,"Y")
  3332.       IF UpldIndex = HiLiteRec THEN _
  3333.          HiLiteRec = -1 : _
  3334.          HiLitePos = 0 : _
  3335.          CALL CheckColor (ZOutTxt$,FoundString$,"")
  3336. 58177 IF ZLocalUser THEN _
  3337.          CALL QuickTPut1 (ZOutTxt$) : _
  3338.          GOTO 58178
  3339.       CALL EofComm (Char)
  3340.       IF Char = -1 THEN _
  3341.          CALL QuickTPut1 (ZOutTxt$) _
  3342.       ELSE ZSubParm = 5 : _
  3343.            CALL TPut : _
  3344.            IF ZRet THEN _
  3345.               GOTO 58183
  3346. 58178 IF ZLinesPrinted <= MaxPrint AND (FMSCheckPoint MOD 1000 <> 0) THEN _
  3347.          GOTO 58168
  3348.       CALL CheckCarrier
  3349.       IF ZSubParm = -1 THEN _
  3350.          GOTO 58183
  3351.       CALL TimeRemain (MinsRemaining)
  3352.       IF MinsRemaining <= 0 THEN _
  3353.          ZSubParm = -1 : _
  3354.          GOTO 58183
  3355.       IF ZNonStop THEN _
  3356.          GOTO 58168
  3357.       IF ZLinesPrinted <= MaxPrint THEN _
  3358.          IF ZDateOrderedFMS THEN _
  3359.             CALL QuickTPut1 (ZEmphasizeOff$ + _
  3360.                "Files checked thru " + MID$(PartToPrint$,24,8)) _
  3361.          ELSE _
  3362.             CALL QuickTPut1 (ZEmphasizeOff$ + STR$(FMSCheckPoint) + _
  3363.                " files checked")
  3364. 58180 ZTurboKey = -ZTurboKeyUser
  3365.       ZStackC = ZTrue
  3366.       CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse)
  3367.       IF ZSubParm = -1 THEN _
  3368.          GOTO 58183
  3369.       IF ZNo THEN _
  3370.          GOTO 58183
  3371.       CALL AraAllCaps (ZUserIn$(),1)
  3372.       IF ZUserIn$(1) = "V" THEN IF CanView THEN _
  3373.          ZLastIndex = ZWasQ : _
  3374.          ZAnsIndex = 1 : _
  3375.          CALL GetArc : _
  3376.          ZJumpSupported = ZTrue : _
  3377.          ZWasA = UpldIndex : _
  3378.          GOSUB 58185 : _
  3379.          UpldIndex = ZWasA : _
  3380.          GOTO 58180
  3381.       IF ZUserIn$(1) = "D" THEN IF CanDnld THEN _
  3382.          ZOutTxt$ = "Download what file(s)" : _
  3383.          ZStackC = ZTrue : _
  3384.          CALL PopCmdStack : _
  3385.          IF ZWasQ = 0 THEN _
  3386.             GOTO 58180
  3387.       IF ZJumpSearching THEN _
  3388.          PrevSearch$ = SearchFor$ : _
  3389.          SearchFor$ = ZJumpTo$ _
  3390.       ELSE SearchFor$ = SearchString$ : _
  3391.            IF LEN(ZUserIn$(1)) > 1 THEN _
  3392.            IF NOT ZYes AND CanDnld THEN _
  3393.               CALL SkipLine (1) : _
  3394.               DnldFlag = UpldIndex : _
  3395.               ZLastIndex = ZWasQ : _
  3396.               ZAnsIndex = 1 : _
  3397.               EXIT SUB
  3398.       IF ZNonStop THEN IF UpldIndex > 999 THEN _
  3399.          IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
  3400.             ZOutTxt$ = STR$(UpldIndex) + _
  3401.                " lines left to search.  Really go non-stop? (Y,[N])" : _
  3402.             ZNoAdvance = ZTrue : _
  3403.             ZTurboKey = -ZTurboKeyUser : _
  3404.             ZSubParm = 1 : _
  3405.             CALL TGet : _
  3406.             CALL WipeLine (79) : _
  3407.             ZNonStop = ZYes
  3408.       GOTO 58168
  3409. 58182 IF ZChainedDir$ <> "" THEN _
  3410.          ZActiveFMSDir$ = ZChainedDir$ : _
  3411.          GOSUB 58185 : _
  3412.          GOTO 58168
  3413. 58183 CLOSE 2
  3414.       ZNonStop = (ZPageLength < 1)
  3415.       ZStopInterrupts = ZFalse
  3416.       ZOutTxt$ = ""
  3417.       ZActiveFMSDir$ = ""
  3418.       ZJumpSupported = ZFalse
  3419.       EXIT SUB
  3420. 58185 CALL OpenFMS (UpldIndex)
  3421.       EndDesc = 33 + ZMaxDescLen
  3422.       FIELD 2, EndDesc AS PartToPrint$, _
  3423.                3 AS Category$, _
  3424.                2 AS Filler$
  3425.       PrevFMS$ = ZActiveFMSDir$
  3426.       IF ZUpInc = -1 THEN _
  3427.          CutoffRec = 0 : _
  3428.          UpldIndex = UpldIndex + 1 _
  3429.       ELSE CutoffRec = UpldIndex + 1 : _
  3430.            UpldIndex = 0
  3431.       RETURN
  3432. 58187 ZOutTxt$ = PartToPrint$
  3433.       CALL AllCaps (ZOutTxt$)
  3434.       HiLitePos = INSTR(ZOutTxt$,SearchFor$)
  3435.       IF HiLitePos < 1 THEN _
  3436.          GOTO 58168
  3437.       HiLiteRec = UpldIndex
  3438.       UpldIndex = LastFName
  3439.       GET 2,UpldIndex
  3440.       FoundString$ = SearchFor$
  3441.       IF ZJumpSearching THEN _
  3442.          SearchFor$ = PrevSearch$
  3443.       GOTO 58175
  3444.       END SUB
  3445.